perm filename PARSER.SAI[OK,TES]1 blob
sn#112214 filedate 1974-07-16 generic text, type T, neo UTF8
ENTRY MANUSCRIPT ;
BEGIN "PARSER"
DEFINE TERNAL = "EXTERNAL" , PRELOAD = "COMMENT" ;
REQUIRE "PUBDFS" SOURCE!FILE ;
REQUIRE "PUBMAI" SOURCE!FILE ;
BEGIN "INNER BLOCK"
REQUIRE "PUBINR" SOURCE!FILE ;
REQUIRE "PUBPRO" SOURCE!FILE ;
EXTERNAL INTEGER PROCEDURE XLENGTH(STRING S);
EXTERNAL RECURSIVE BOOLEAN PROCEDURE TEXTLINE ;
EXTERNAL RECURSIVE PROCEDURE DBREAK ;
EXTERNAL STRING SIMPLE PROCEDURE LABELREF(INTEGER USYMB, LEN) ;
FORWARD INTERNAL RECURSIVE BOOLEAN PROCEDURE CHUNK(BOOLEAN VALID) ;
FORWARD INTERNAL RECURSIVE STRING PROCEDURE E(STRING DEFAULT, STOPWORD) ;
EXTERNAL SIMPLE STRING PROCEDURE PICKFONT(INTEGER F) ;
IFC TENEX THENC
STRING PROCEDURE SCANTO(STRING BRKS; REFERENCE STRING SCANNEE; BOOLEAN INCLUDE) ;
BEGIN
INTEGER DUMMY ;
SETBREAK(LOCAL!TABLE, BRKS, NULL, IF INCLUDE THEN "IA" ELSE "IR") ;
RETURN(SCAN(SCANNEE, LOCAL!TABLE, DUMMY)) ;
END ;
STRING SIMPLE PROCEDURE CVFIL(STRING FILENAME; REFERENCE STRING EXT, PPN) ;
BEGIN
STRING NAME ;
PPN ← IF FILENAME[1 FOR 1] = "<" THEN SCANTO(">", FILENAME, TRUE) ELSE NULL ;
NAME ← SCANTO(".;", FILENAME, FALSE) ;
EXT ← IF FILENAME[1 FOR 1] = "." THEN SCANTO(";", FILENAME, FALSE) ELSE NULL ;
RETURN(NAME) ;
END ;
SIMPLE STRING PROCEDURE INCHWL ;
BEGIN
STRING S ; INTEGER C ;
S ← NULL ;
DO
BEGIN
C ← PBIN ;
IF C = CTLA THEN IF NULSTR(S) THEN ELSE
BEGIN
PBOUT("\") ;
PBOUT(S[∞ FOR 1]) ;
S ← S[1 TO ∞-1] ;
END
ELSE IF C = CTLS THEN OUTSTR(" =" & EOL & "#" & S)
ELSE IF C = EOL OR C = ALTMODE THEN RETURN(S)
ELSE IF C = CTLV THEN S ← S & PBIN
ELSE IF C=RUBOUT THEN
BEGIN
OUTSTR(" XXX" & EOL & "#") ;
S ← NULL ;
END
ELSE S ← S & C ;
END UNTIL FALSE ;
END "INCHWL" ;
ENDC
INTERNAL STRING SIMPLE PROCEDURE RD(INTEGER BRKTBL) ;
BEGIN
COMMENT INPUTSTR = [ [chars] LF line-no TB ]... [chars]
All break tables should break on LF.
RD's value is as if LF line-no TB were null. ;
INTEGER PTR, BYTEWD ; STRING SPTR, RESULT, PART ;
RESULT ← NULL ;
DO BEGIN "PARTIAL"
PART ← SCAN(INPUTSTR, BRKTBL, BRC) ;
IF BRC = LF THEN
BEGIN "MACRO LINE NUMBER"
MACLINE ← SCAN(INPUTSTR, TO!TB!FF!SKIP, DUMMY) ;
IF PART[∞ FOR 1] = LF THEN comment he Appended the break character ;
PART ← IF DEFINING THEN PART & MACLINE & TB ELSE PART[1 TO ∞-1]
ELSE IF DEFINING THEN PART ← PART & LF & MACLINE & TB ;
END "MACRO LINE NUMBER"
ELSE IF BRC = 0 THEN comment, ran out of input ;
IF INPUTCHAN < 0 THEN INPUTSTR ← SWICHBACK comment, done scanning macro body ;
ELSE BEGIN "FROM FILE"
DO BEGIN comment, may be page marks or eof or more lines ;
IF TECOFILE THEN
BEGIN COMMENT CHECK FOR FF AND SUPERFLUOUS LFs ;
SRCLINE ← CVS(CVD(SRCLINE)+1) ;
INPUT(INPUTCHAN, NO!CHARS) ;
WHILE BRC = LF DO
BEGIN
INPUT(INPUTCHAN,ONE!CHAR) ;
INPUT(INPUTCHAN,NO!CHARS) ;
END ;
END
ELSE SRCLINE ← INPUT(INPUTCHAN, TO!TB!FF!SKIP) ;
IF BRC = FF THEN
BEGIN "PGMARK"
PAGEMARKS ← PAGEMARKS + 1 ;
IF TECOFILE THEN
BEGIN
INPUT(INPUTCHAN, ONE!CHAR) ;
SRCLINE ← "0" ;
END ;
WHILE INPGS ∧ LAST=4 ∧ BRC=FF ∧ PAGEMARKS>RH(INPG[INPGX]) DO
IF (INPGX←INPGX+1)>INPGS THEN BEGIN BRC←0 ; EOF←1 END
ELSE IF PAGEMARKS<(K←LH(INPG[INPGX])) THEN
DO BEGIN "SKIP PAGES"
DO INPUT(INPUTCHAN,TO!LF!TB!VT!SKIP)
UNTIL BRC≠TB;
IF BRC = LF THEN
DO BEGIN
SRCLINE←INPUT(INPUTCHAN,TO!TB!FF!SKIP);
IF BRC=FF THEN PAGEMARKS←PAGEMARKS+1 ;
END UNTIL BRC≠FF ;
END "SKIP PAGES"
UNTIL BRC≠TB ∨ PAGEMARKS ≥ K ;
IF ¬EOF THEN
BEGIN COMMENT COMPUTE AND DISPLAY PAGE NUMBER ;
SRCPAGE ← CVS(PAGEMARKS) ;
IF NOT PUBSTD THEN OUTSTR((
IF SWDBACK THEN SPS(LAST-3)
ELSE SP
)&SRCPAGE) ;
SWDBACK ← 0 ;
END ;
END "PGMARK" ;
END
UNTIL BRC ≠ FF ;
MACLINE ← NULL ;
IF FULSTR(LSTOP) ∧ EQU(ERRLINE&"/"&SRCPAGE, LSTOP) THEN
BEGIN
DARN(NULL,VS(THISWD)&VS(THATWD)&VS(INPUTSTR)&CRLF&
VS(OWL[1 TO OAKS])&CRLF&VI(POSN)&VI(BRC)&VI(BRKTBL)) ;
S ← INCHWL ; LSTOP←("0000"&SCAN(S,DIGITA,DUMMY))[∞-4 FOR 5]&S ;
END ;
IF EOF THEN INPUTSTR ← SWICHBACK comment, done scanning a SOURCE!FILE or gen-file;
ELSE BEGIN "FILE LINE"
DO BEGIN "EXPAND TABS"
INPUTSTR ← INPUTSTR & INPUT(INPUTCHAN,TO!LF!TB!VT!SKIP) ;
IF BRC=TB THEN INPUTSTR←INPUTSTR&
(IF PAGESCAN(LAST)≥0 THEN
IF TABTAB=0 THEN
SPS(8-LENGTH(INPUTSTR) MOD 8)
ELSE TABTAB
ELSE TB)
ELSE IF BRC=VT THEN
IF INPUTSTR[∞ FOR 1]=RCBRAK THEN INPUTSTR←INPUTSTR&VT
ELSE
BEGIN "GENVT" COMMENT MAYBE {PAGE!} IN GEN-FILE ;
SPTR ← INPUT(INPUTCHAN, TO!VT!SKIP) ;
IF (PTR ← CVD(SPTR)) ≥ TWO(14)
AND LDB(PLIGHTWD("BYTEWD←ITBL[PTR-TWO(14)]"))=2
THEN
BEGIN
BREAKSET(LOCAL!TABLE,ALTMODE,"IS");
BREAKSET(LOCAL!TABLE,NULL,"O");
S ← STBL[LDB(IXWD(BYTEWD))] ;
INPUTSTR ← INPUTSTR[1 TO ∞-6] &
SCAN(S,LOCAL!TABLE,DUMMY);
END
ELSE INPUTSTR ← INPUTSTR & VT & SPTR & VT ;
END "GENVT"
END "EXPAND TABS"
UNTIL BRC = LF ∨ BRC < 0 ∨ EOF ;
IF BRC≤0 THEN
BEGIN BRC ← LF ;
IF ¬EOF THEN
WARN("=","GARBAGED MANUSCRIPT "&ERRLINE&"/"&SRCPAGE)
END ;
IF DEFINING THEN PART ← PART & LF & SRCLINE & "/" & SRCPAGE & TB ;
END "FILE LINE" ;
END "FROM FILE" ;
IF BRC = LF THEN
IF DEFINING THEN BEGIN BRC←0 ; IF INPUTSTR=COMMAND!CHARACTER THEN
BEGIN PART ← PART & TB ; LOPP(INPUTSTR) ; END END
ELSE IF INPUTSTR = COMMAND!CHARACTER ∨ INPUTSTR = TB THEN
BEGIN
LOPP(INPUTSTR) ;
BRC ← 0 ; comment, keep scanning ;
END
ELSE INPUTSTR ← (BRC ← RCBRAK) & VT & INPUTSTR ;
IF BRC THEN RETURN(IF LENGTH(RESULT)=0 THEN PART
ELSE IF LENGTH(PART)=0 THEN RESULT
ELSE RESULT & PART)
ELSE IF LENGTH(RESULT)=0 THEN RESULT ← PART
ELSE RESULT ← RESULT & PART ;
END "PARTIAL"
UNTIL FALSE ;
END "RD" ;
INTERNAL SIMPLE PROCEDURE RDENTITY ;
BEGIN Comment Sets THATWD, THATTYPE, LIT!ENTITY, LIT!TRAIL ;
STRING SEGMENT, SOURCE ; BOOLEAN DUN, TEXTLN ; INTEGER CC, FAM ; LABEL RETRY ;
TEXTLN ← FALSE ; RETRY: IF CHARTBL[INPUTSTR] LAND TWO(6) THEN RD(TO!VISIBLE) ;
SOURCE ← INPUTSTR ;
FAM ← LDB(FAMILY(SOURCE)) ;
CASE FAM MIN QUOTEQ+1 OF
BEGIN COMMENT BY FAMILY ;
ie 0 ... Letter ;
BEGIN "BUILD ID"
CC ← LENGTH(SEGMENT ← SCAN(SOURCE, ALPHA, BRC)) ;
THATWD ← CAPITALIZE(SEGMENT);
THATTYPE ← 0 ;
END "BUILD ID" ;
ie 1 ... Digit ;
BEGIN "BUILD INTEGER"
CC ← LENGTH(THATWD ← "0" & SCAN(SOURCE, DIGITA, BRC)) - 1 ;
THATTYPE ← -1 ;
END "BUILD INTEGER" ;
ie 2 ... EMPTYQ ; IMPOSSIBLE("RDENTITY") ;
ie 3 ... Terminal ;
BEGIN "MAYBE TEXT"
IF LDB(SPECIES("THATWD ← LOP(SOURCE)")) = 0 THEN TEXTLN ← TRUE ;
CC ← 1 ; THATTYPE ← -TERQ ;
END "MAYBE TEXT" ;
ie 4 ... Quote ;
IF SOURCE = """" THEN
BEGIN "STRING CONSTANT"
DUN ← FALSE ; THATWD ← "7" ; LOPP(SOURCE) ; CC ← 1 ; ie skip " ;
DO BEGIN "TO NEXT QUOTE"
SEGMENT ← SCAN(SOURCE, TO!QUOTE!APPD, BRC) ;
CC ← CC + LENGTH(SEGMENT) ;
IF BRC ≠ """" THEN
BEGIN "ERROR"
THATWD ← THATWD & SEGMENT[1 TO ∞-1] ; DUN ← TRUE ;
WARN("=","Omitted Right Quote From: "&THATWD) ;
END "ERROR"
ELSE IF SOURCE = """" THEN
BEGIN "INTERNAL QUOTE"
THATWD ← THATWD & SEGMENT ;
LOPP(SOURCE) ; CC ← CC + 1 ; ie skip second " ;
END "INTERNAL QUOTE"
ELSE
BEGIN "END STRING"
THATWD ← THATWD & SEGMENT[1 TO ∞-1] ;
DUN ← TRUE ;
END "END STRING"
END "TO NEXT QUOTE"
UNTIL DUN ;
THATTYPE ← -1 ;
END "STRING CONSTANT"
ELSE
BEGIN "OCTAL CONSTANT"
LOPP(SOURCE) ; THATTYPE ← -1 ;
CC ← LENGTH(SEGMENT ← SCAN(SOURCE, DIGITA, BRC)) + 1 ;
THATWD ← "8" & (DUMMY←CVO(SEGMENT)) ; COMMENT a one-character string ;
IF NOT INPICHAR THEN TES 12/6/73 ;
IF DUMMY='0 ∨ '11≤DUMMY≤'15 ∨ DUMMY=ALTMODE ∨ DUMMY=RUBOUT THEN
BEGIN
WARN("ILL OCTAL",
"Illegal octal constant (represents illegal character) "&CVOS(DUMMY)) ;
THATWD ← "7" ;
END ;
END "OCTAL CONSTANT" ;
ie 5 ... Other ;
BEGIN "SINGLE CHARACTER"
THATTYPE ← -FAM ; CC ← 1 ; THATWD ← LOP(SOURCE) ;
IF FAM = MISCQ THEN CASE LDB(SPECIES(THATWD)) OF
BEGIN
[4] ie ∞ ; BEGIN THATTYPE ← 0 ; THATWD ← "!INF" END ;
[0] BEGIN "ILL CHAR"
WARN("=","EXTRANEOUS `" & THATWD & "' in command line") ;
LOPP(INPUTSTR) ; GO TO RETRY ;
END "ILL CHAR" ;
[MISCMAX]
END ;
END "SINGLE CHARACTER" ;
END ; COMMENT BY FAMILY ;
LIT!ENTITY ← INPUTSTR[1 TO CC] ;
INPUTSTR ← SOURCE ;
LIT!TRAIL ← IF TEXTLN THEN NULL ELSE IF CHARTBL[INPUTSTR] LAND TWO(6) THEN RD(TO!VISIBLE) ELSE NULL ;
END "RDENTITY" ;
INTEGER SIMPLE PROCEDURE ESTIMATE ;
BEGIN
INTEGER TOT, LEFT ;
TOT ← LEFT ← IF AREAIXM ∧ 0≤STATUS≤2 THEN LINES ELSE LINECT(IXTEXT) ;
LEFT ← LEFT + XGENLINES; RKJ;
IF STATUS=1 THEN LEFT ← LEFT - (LINE + COVERED + PINE) ;
IF NOT NOPGPH THEN LEFT ← LEFT - ( 1+(ABOVEX MAX BRKABX)-(BELOWX MIN BRKBLX)+
(IF NOFILL THEN LEADNM ELSE IF FIRST THEN LEADFM ELSE SPREADM-1) ) ;
RETURN(IF LEFT<0 THEN -(LEFT+TOT) ELSE LEFT) ;
END "ESTIMATE" ;
INTEGER SIMPLE PROCEDURE EMPTYCOLS ;
IF COL = 0 THEN RETURN(COLS)
ELSE BEGIN
INTEGER COUNT, COLUMN ; COUNT ← 0 ;
FOR COLUMN ← (COL - 1) MOD COLS + 1 THRU COLS DO
IF AA[COLUMN, 0] = 0 ∧ AA[COLUMN+COLS,0] = 0 THEN COUNT ← COUNT + 1 ;
RETURN(COUNT-(IF ESTIMATE<0 THEN 1 ELSE 0)) ;
END "EMPTYCOLS" ;
STRING PROCEDURE TYPEIN ;
BEGIN
IF NOT ON THEN RETURN (NULL); RKJ: 5-10-74 ;
IF NOT SWDBACK THEN OUTSTR(CRLF) ;
OUTSTR("#") ; SWDBACK ← TRUE ;
RETURN(INCHWL) ;
END "TYPEIN" ;
INTERNAL STRING SIMPLE PROCEDURE EVALV(STRING THISWD ; INTEGER IX, TYP) ;
BEGIN comment, evaluates the "variable" in THISWD ;
CASE TYP OF
BEGIN COMMENT BY TYPE ;
[0] BEGIN IF ON THEN WARN("=","Undefined Identifier " & THISWD) ; RETURN(VIRGIN) END ;
[GLOBALTYPE] RETURN(STBL[IX]) ;
[LOCALTYPE] RETURN(SSTK[IX]) ;
[INTERNTYPE]
BEGIN "INTERNAL"
RETURN(CASE IX OF (
ie 0 ... LINES ; CVS(ABS(ESTIMATE)),
ie 1 ... COLUMNS; CVS(CASE STATUS+1 OF (
ie -1 ... no place area ; 0,
ie 0 ... unopened area ; COLS-(IF ESTIMATE<0 THEN 1 ELSE 0),
ie 1 ... open area ; EMPTYCOLS,
ie 2 ... closed area ; 0,
ie 3 ... dis-declared ; 0) ),
ie 2 ... ! ; !,
ie 3 ... SPREAD ; CVS(SPREADM),
ie 4 ... FILLING; IF ¬FILL THEN "0" ELSE IF ADJUST THEN "1" ELSE "-1",
ie 5 ... !SKIP! ; CVS(MANUS!SKIP!),
ie 6 ... !SKIPL!; CVS(LH(MANUS!SKIP!)),
ie 7 ... !SKIPR!; CVS(RH(MANUS!SKIP!)),
ie 8 ... NULL ; NULL,
ie 9 ... ∞ ; CVS(INF),
ie 10... FOOTSEP; FOOTSEP,
ie 11... TRUE ; "-1",
ie 12... FALSE ; "0",
ie 13... INDENT1; CVS(FIRSTIM),
ie 14... INDENT2; CVS(RESTIM),
ie 15... INDENT3; CVS(RIGHTIM),
ie 16... LMARG ; CVS(LMARG),
ie 17... RMARG ; CVS(RMARG),
ie 18... CHAR ; IF NOPGPH THEN "0" ELSE CVS(POSN), TES 0->"0" 5/26/74;
ie 19... CHARS ; CVS(IF NOPGPH THEN RMARG-LMARG ELSE MAXIM-POSN),
ie 20... LINE ; CVS(IF STATUS=1 THEN LINE ELSE 0),
ie 21... COLUMN ; CVS(IF STATUS=1 THEN COL ELSE 0),
ie 22... TOPLINE; CVS(LINE1(IF AREAIXM THEN AREAIXM ELSE IXTEXT)),
ie 23... XCRIBL; CVS(XCRIBL),
ie 24... CHARW ; CVS(CHARW),
ie 25... XGENLINES; CVS(XGENLINES),
ie 26... UNDERLINE ; VUNDERLINE, TES 10/22/73 ;
ie 27... THISDEVICE ; TES 11/15/73 ;
CASE ABS(DEVICE)-1 OF ("LPT","TTY","MIC","XGP"),
ie 28... THISFONT ; IF THISFONT < 10 THEN
THISFONT+"0" ELSE THISFONT+("A"-10),
ie 29... FOOTGAP ; CVS(FOOTGAP), TES 11/27/73 ;
ie 30... FOOTSEPFONT ; PICKFONT(FSFONT)[3 FOR 1], TES 11/29/73 ;
ie 31... TTY ; TYPEIN, TES 11/29/73 ;
ie 32... ODDLEFTBORDER ; CVS(ODDLEFTBORDER), TES 6/11/74 ;
ie 33... EVENLEFTBORDER ; CVS(EVENLEFTBORDER), TES 6/11/74 ;
ie 34... FULLFILE ; INFILE, TES 6/13/74 ;
WARN(NULL,"PUB BUG: EVALV CASE IX")
) ) ;
END "INTERNAL" ;
[MANTYPE] WARN("=",THISWD&" in an expression") ;
[PORTYPE] RETURN(THISWD) ;
[PUNITTYPE] RETURN(PATT!VAL("PATT!STRS(IX)")) ;
[AREATYPE] RETURN(THISWD) ;
[UNITTYPE] RETURN(CTR!VAL("PATT!STRS(IX)"))
END COMMENT BY TYPE ; ;
RETURN(NULL) ;
END "EVALV" ;
INTERNAL STRING SIMPLE PROCEDURE VEVAL ; RETURN(EVALV(THISWD, IX, THISTYPE)) ;
INTERNAL RECURSIVE STRING PROCEDURE PASS ; comment Value is always NULL ;
BEGIN comment, Load up WD[0:1], TYPE[0:1], SYMB, and IX for the parser.
Calls CHUNK recursively! PASS will expand macro calls,
replace macro/response arguments with their actual values,
skip over comments, and execute asides.;
PRELOAD!WITH 0, [3]3, 2, [4]3, 0, 1, 0, 4, [5]0, 5, 0, 0, 6, [7]0, 7, 0 ;
OWN INTEGER ARRAY SCANTYPE[-15:15] ; comment, computes small case index ;
BOOLEAN FINAL ;
DO BEGIN "LOAD WD 0"
IF ¬THATISFULL THEN RDENTITY ;
THISWD ← THATWD ;
THISTYPE ← IF THATTYPE THEN THATTYPE comment, non-identifier ;
ELSE IF SYMLOOK(THATWD) THEN LDB(TYPEN(SYMBOL))
ELSE 0 ; comment, undeclared identifier ;
IF THISTYPE ≠ -TERQ THEN RDENTITY ;
IF THISISID THEN
BEGIN "IDENTIFIER"
SYMB ← SYMBOL ;
IF ¬DCLR!ID ∧ THATISID ∧ SYMLOOK(THISWD & SP & THATWD) THEN
BEGIN comment, two-word macro name ;
THISWD ← SYM[SYMB←SYMBOL] ; THISTYPE ← MACROTYPE ;
IX ← LDB(IXN(SYMBOL)) ; RDENTITY ;
END
ELSE BEGIN SYMBOL←SYMB ; IF NULSTR(SYM[SYMB]) THEN ENTERSYM(THISWD,0) ; IX←LDB(IXN(SYMB)) ;END ;
END "IDENTIFIER" ;
FINAL ← FALSE ;
DO CASE SCANTYPE[THISTYPE] OF
BEGIN COMMENT DETECT ;
ie 0 ... Nothing to do ; BEGIN END ;
ie 1 ... $ ; IF NEXTSCH("(") THEN
BEGIN EMPTYTHAT ; THISWD←"⊂" ;
IX ← LDB(SPECIES(THISWD)) ; THISTYPE ← -TERQ ;
END
ELSE IX←LDB(SPECIES(THISWD)) ; COMMENT REPLACED OLD "ASIDE" (UNPUBL. FEATURE) 2/20/73 ;
ie 2 ... < Family ; IF ITSCH(<) AND NEXTSCH(<) THEN
BEGIN "<<COMMENT>>" SETBREAK(LOCAL!TABLE, ">"&RCBRAK&LF, NULL, "IS") ;
DO RD(LOCAL!TABLE) UNTIL BRC=">" ∧ INPUTSTR=">" ∨ BRC=RCBRAK ∧ INPUTSTR=VT ;
IF BRC=">" THEN RD(ONE!CHAR)
ELSE BEGIN WARN("=","Unterminated <<comment>>") ; INPUTSTR←BRC&INPUTSTR END ;
EMPTYTHIS ; EMPTYTHAT ;
END "<<COMMENT>>"
ELSE IX ← LDB(SPECIES(THISWD)) ; ie relational operator ;
ie 3 ... Expression Operators ; IX ← LDB(SPECIES(THISWD)) ;
ie 4 ... Terminal ;
BEGIN
IF ITSCH("]") ∧ INPUTSTR="$" THEN
BEGIN LOPP(INPUTSTR) ; THISWD ← RCBRAK END ;
EMPTYTHAT ; IX ← LDB(SPECIES(THISWD)) ;
END ; Comment NOTE!! }),]⊂;
ie 5 ... internal variable ; IF ¬DCLR!ID ∧ IX ≥ 200 THEN
BEGIN "OPERATOR"
IX ← IX-200 ; comment e.g., NOT → ¬ ;
THISTYPE ← -LDB(FAMILY(IX)) ;
IX ← LDB(SPECIES(IX)) ;
END "OPERATOR" ;
ie 6 ... reserved word ; IF IX=IXCOMMENT∧ ¬DCLR!ID THEN
BEGIN "COMMENT"
INPUTSTR ← LIT!ENTITY & INPUTSTR ;
DO RD(TO!SEMI!SKIP) UNTIL BRC=";" ∨ INPUTSTR=VT ;
IF BRC ≠ ";" THEN BEGIN WARN("=","Unterminated COMMENT;") ; INPUTSTR←BRC&INPUTSTR END ;
EMPTYTHIS ; EMPTYTHAT ; ;
END "COMMENT" ;
ie 7 ... macro name ; IF ¬DCLR!ID THEN
BEGIN "EXPAND MACRO"
INTEGER MACIX, MACSYM, ARGS, ARG, ARGSYM, NAMES, K ; BOOLEAN WASLPAR, DO!IT, DUMSEMI ;
DO!IT ← ON OR ODDMAC(IX) ; comment Whether to actually expand it, or make it NULL;
MACIX ← IX ; MACSYM ← SYMB ; ARGS ← NUMARGS(MACIX) ; DUMSEMI ← FALSE ;
IF ARGS THEN
BEGIN "SCAN ARGS"
STRING ARRAY ACTUAL[1:ARGS] ;
IF ¬(WASLPAR ← NEXTSCH("(")) THEN INPUTSTR ← LIT!ENTITY&LIT!TRAIL&INPUTSTR ;
comment , Back up. Pretend just passed comma. ; THISWD ← "," ; EMPTYTHAT ;
NAMES ← NAMEPAR(MACIX) ; comment bit table for name parameters ;
FOR ARG ← 1 THRU ARGS DO
BEGIN "EACH ACTUAL"
IF ¬ITSCH(",") THEN ACTUAL[ARG] ← NULL comment , omitted argument;
ELSE BEGIN RD(TO!VISIBLE) ;
IF NAMES LAND TWO(ARGS-ARG) = 0 THEN
BEGIN PASS ; ACTUAL[ARG] ← E(NULL, NULL&'0) ; END
ELSE BEGIN "CALL BY NAME"
IF BRC ≠ """" THEN
BEGIN comment , Unquoted Call-By-Name ;
IF (K←BRC)="|" THEN RD(ONE!CHAR) ;
ACTUAL[ARG]←RD(IF K="|" THEN TO!VBAR!SKIP
ELSE IF WASLPAR THEN TO!COMMA!RPAR ELSE TO!TERQ!CR) ;
IF BRC=CR ∧ ¬WASLPAR THEN
BEGIN comment force a semicolon ;
INPUTSTR ← ";" & INPUTSTR ;
DUMSEMI ← TRUE ;
END ;
PASS ;
END
ELSE BEGIN PASS ; ACTUAL[ARG]←E(NULL,0) END ;
END "CALL BY NAME"
END
END "EACH ACTUAL" ;
WHILE ITSCH(",") DO
BEGIN
WARN("=","Too Many Arguments to "&SYM[MACSYM]) ;
PASS ; E(NULL, 0) ;
END ;
IF ITSCH(")") ∧ WASLPAR THEN BEGIN comment Easy case; END
ELSE BEGIN
IF WASLPAR THEN WARN("=","Missed ) After Macro Call") ;
comment Back Up -- SWICH only saves THATWD ;
IF THATISFULL THEN comment Unlikely; INPUTSTR ← LIT!ENTITY&LIT!TRAIL&INPUTSTR ;
IF THISISFULL ∧ ¬DUMSEMI THEN BEGIN THATWD ← LIT!ENTITY ← THISWD ;
LIT!TRAIL ← IF THISTYPE<-1 THEN NULL ELSE SP ;
THATTYPE ← THISTYPE MIN 0 END ELSE EMPTYTHAT ;
END ;
IF DO!IT THEN
BEGIN "STACK ARGUMENTS"
IF LAST + ARGS > SIZE THEN GROWNESTS ;
FOR ARG ← 1 THRU ARGS DO
SNEST[LAST + ARG] ← ACTUAL[ARG] ;
LAST ← LAST + ARGS ;
END "STACK ARGUMENTS" ;
END "SCAN ARGS" ;
IF DO!IT THEN SWICH(SSTK[BODY(MACIX)], -1, ARGS)
ELSE BEGIN THISWD ← "7" ; THISTYPE ← -1 END ; ie, Replace by NULL ("") ;
END "EXPAND MACRO" ;
END COMMENT DETECT ; UNTIL (FINAL ← ¬FINAL) ;
END "LOAD WD 0" UNTIL THISISFULL ;
RETURN(NULL) ;
END "PASS" ;
INTERNAL RECURSIVE STRING PROCEDURE E(STRING DEFAULT, STOPWORD) ;
COMMENT Scan a SAIL-Like <Expression>. First check trivial case. ;
IF ITS(IF) THEN
BEGIN "CONDITIONAL EXPRESSION"
STRING BOOLX, THENX, ELSEX ; BOOLEAN WASON ;
WASON ← ON ; PASS ;
BOOLX ← E(NULL, "THEN") ; ON ← WASON ∧ TRUESTR(BOOLX) ;
IF ITS(THEN) THEN PASS ELSE WARN("=","Missed THEN in conditional expression "&THISWD) ;
THENX ← E(NULL, "ELSE") ;
IF ITS(ELSE) THEN
BEGIN
ON ← WASON ∧ FALSTR(BOOLX) ; PASS ;
ELSEX ← E(NULL, STOPWORD) ;
END
ELSE ELSEX ← NULL ;
ON ← WASON ;
RETURN(IF TRUESTR(BOOLX) THEN THENX ELSE ELSEX) ;
END "CONDITIONAL EXPRESSION"
ELSE IF THISTYPE = -TERQ ∨ THISTYPE = MANTYPE ∨ ITSV(STOPWORD) THEN
RETURN(DEFAULT) comment omitted expression ;
ELSE IF THISTYPE ≥ -1 ∧ (THATTYPE = -TERQ ∨ THATTYPE=MANTYPE ∨ NEXTSV(STOPWORD)) THEN
RETURN(SPASS("IF THISISCON THEN THISWD[2 TO ∞] ELSE VEVAL"))
ELSE IF THISISID ∧ NEXTSCH(←) THEN comment, Assignment Expression ;
RETURN(VASSIGN(SYMB, THISTYPE, IX, E(IPASS(PASS), STOPWORD)))
ELSE
BEGIN "SIMPLE EXPRESSION"
STRING ANY, comment, result of A∨B∨...: has value of first TRUE operand;
ALL, comment, result of A∧B∧...: has value of first FALSE operand;
COMPARE, comment, result of A<B≤...: TRUE if all relations are TRUE;
LEFT, comment, preceding right comparator, saved for another comparison;
BOUNDARY, comment, result of A MAX B MIN... ;
PRODUCT, comment, result of * / MOD & ;
PRIMARY ; comment, <const>|<var>|( <expr> )|<unary><primary>|<primary><substr spec> ;
INTEGER OROP, comment, =0 signals ∨ waiting for right operand ;
ANDOP, NOTOP, comment, =0 signals ∧ or ¬ operator waiting ;
RELOP, ODDOP, BOUNDOP, ADDOP, MULOP, comment, ≥0 signals operator waiting ;
UNARYOP, comment, ≥0 signals unary operators waiting ;
U, comment, last of a series of unary operators ;
SS1, comment, starting byte number in substring spec ;
SAVEINF, comment, saved outside value of ∞ ;
SYMPTR, comment, symbol table number of identifier ;
IDTYPE, comment, type field in its NUMBER entry ;
ICOMPARE, ILEFT, IBOUNDARY, ISUM, IPRODUCT, IPRIMARY ; comment, CVD(corresponding string);
BOOLEAN WASONA, WASONO ; comment value of ON before a series of conjuncts or disjuncts ;
DEFINE TRYFAMILY(FAM) = "IF THISTYPE=-FAM THEN IPASS(IX)";
COMMENT Multiple Unary operators ( + , - , ABS , LENGTH , and ↑ ) are combined
into a single operator by inventing new operators such as
"-ABS" and "ABS LENGTH" ;
DEFINE P = "0", comment, +X ; M = "1", comment, -X ; A = "2", comment, ABS X ;
MA = "3", comment, -ABS X ; C = "4", comment, ↑X ;
L = "5", comment, LENGTH(X) ; ML = "6", comment -LENGTH(X) ;
AL = "7", comment, ABS LENGTH(X) ; MAL = "8"; comment, -ABS LENGTH(X) ;
PRELOAD!WITH comment RIGHT OPERATOR
------------------------
LEFT OPERATOR + - ABS ↑ LENGTH
------------- --- --- --- --- --------
none; P, M, A, C, L,
comment P ; P, M, A, P, L,
comment M ; M, P, MA, M, ML,
comment A ; A, A, A, A, AL,
comment MA ; MA, MA, MA, MA, MAL,
comment C ; P, M, A, C, L ;
OWN INTEGER ARRAY COMBINE[-1:4,0:4] ;
COMMENT This is a top-down expression parser, but iteration is used
instead of recursion for rapidity ;
OROP ← ANDOP ← NOTOP ← RELOP ← BOUNDOP ← ADDOP ← MULOP ← -1 ;
WASONO ← ON ;
DO BEGIN "DISJUNCTS" ie Operands of ∨ ;
WASONA ← ON ;
DO BEGIN "CONJUNCTS" ie Operands of ∧ ;
WHILE THISTYPE = -NOTQ DO BEGIN NOTOP ← -1 - NOTOP ; PASS END ;
ICOMPARE ← TRUE ;
DO BEGIN "COMPARATORS" ie Operands of < = etc. ;
ODDOP ← TRYFAMILY(ODDQ) ELSE -1 ;
DO BEGIN "BOUNDS" ie Operands of MAX and MIN ;
DO BEGIN "TERMS" ie Operands of + - ≡ ⊗ ;
DO BEGIN "FACTORS" ie Operands of * / MOD & ;
UNARYOP ← -1 ; ie check for Unary Operators ;
WHILE UNARYOP≤3 ie no, P, M, A, or MA left operator ;
AND 0 ≤ (U ← TRYFAMILY(ADDQ) ELSE -1) ie some right operator ;
DO UNARYOP ← COMBINE[UNARYOP, U] ;
comment PRIMARY ;
IF THISISCON THEN BEGIN PRIMARY ← THISWD[2 TO ∞] ; PASS END
ELSE IF THISISID THEN
IF ITSV(STOPWORD) THEN
BEGIN
PRIMARY ← DEFAULT ;
WARN("=","Ill-Formed Expression" & THISWD) ;
END
ELSE BEGIN PRIMARY ← VEVAL ; PASS END
ELSE IF ITSCH("(") THEN
BEGIN "( <EXPR> )"
PASS ; PRIMARY ← E(DEFAULT, 0) ;
IF ITSCH(")") THEN PASS ELSE WARN("=","Missed )") ;
END "( <EXPR> )"
ELSE BEGIN WARN("=","Ill-Formed expression" & THISWD) ; PRIMARY ← DEFAULT END ;
WHILE THISTYPE=-BROKQ DO ie Substring Specifications ;
BEGIN "SUBSPEC"
PASS ; SAVEINF ← INF ; INF ← LENGTH(PRIMARY) ;
SS1 ← CVD(E("1", IF NEXTS(TO) THEN "TO" ELSE "FOR")) ;
IF ITS(TO) THEN BEGIN PASS ; PRIMARY←PRIMARY[SS1 TO CVD(E("0",0))] END
ELSE IF ITS(FOR) THEN BEGIN PASS ; PRIMARY←PRIMARY[SS1 FOR CVD(E("1",0))] END
ELSE PRIMARY ← PRIMARY[SS1 FOR 1] ;
MANUS!SKIP! ← !SKIP! ;
IF ITSCH(]) THEN PASS ELSE WARN("=","Missed ] in substring spec " & THISWD) ;
INF ← SAVEINF ;
END "SUBSPEC" ;
IF UNARYOP≤3 THEN IPRIMARY ← CVD(PRIMARY) ; ie both int & str versions maintained when needed ;
IF UNARYOP ≥ 0 THEN IF UNARYOP=C THEN IPRIMARY←CVD(PRIMARY←CAPITALIZE(PRIMARY))
ELSE PRIMARY ← CVS(IPRIMARY ← CASE UNARYOP OF (IPRIMARY, -IPRIMARY,
ABS IPRIMARY, -ABS IPRIMARY, 0, LENGTH(PRIMARY), -LENGTH(PRIMARY),
ABS LENGTH(PRIMARY), -ABS LENGTH(PRIMARY) ) ) ;
IF MULOP<0 THEN BEGIN PRODUCT ← PRIMARY ; IPRODUCT ← IPRIMARY END
ELSE IF MULOP = 3 THEN IPRODUCT ← CVD(PRODUCT ← PRODUCT & PRIMARY)
ELSE PRODUCT ← CVS(IPRODUCT ← IF IPRIMARY=0 ∨ ¬ON THEN 0 ELSE CASE MULOP OF
(IPRODUCT*IPRIMARY, IPRODUCT DIV IPRIMARY, IPRODUCT MOD IPRIMARY) ) ;
MULOP ← TRYFAMILY(MULQ) ELSE -1 ;
END "FACTORS" UNTIL MULOP < 0 ;
ISUM ← CASE ADDOP+2 OF (IPRODUCT, IPRODUCT, ISUM + IPRODUCT,
ISUM - IPRODUCT, ISUM ≡ IPRODUCT, ISUM ⊗ IPRODUCT) ;
ADDOP ← TRYFAMILY(ADDQ) ELSE IF ADDOP<0 THEN -1 ELSE -2 ;
END "TERMS" UNTIL ADDOP < 0 ;
IBOUNDARY ← CASE BOUNDOP+2 OF (ISUM, ISUM, IBOUNDARY MAX ISUM, IBOUNDARY MIN ISUM) ;
BOUNDOP ← TRYFAMILY(BOUNDQ) ELSE IF ADDOP=-1 ∧ BOUNDOP<0 THEN -1 ELSE -2 ;
END "BOUNDS" UNTIL BOUNDOP < 0 ;
BOUNDARY ← IF BOUNDOP = -1 THEN PRODUCT ie, hasn't changed since then; ELSE CVS(IBOUNDARY) ;
IF ODDOP≥0 THEN BOUNDARY←CVS(IBOUNDARY←(IBOUNDARY MOD 2)=ODDOP);
IF ICOMPARE THEN CASE RELOP+2 OF BEGIN comment SAIL Bug precludes case expression with relationals;
BEGIN END ; BEGIN END ; ICOMPARE←ILEFT<IBOUNDARY; ICOMPARE←ILEFT>IBOUNDARY; ICOMPARE ←
EQU(LEFT,BOUNDARY); ICOMPARE←ILEFT≤IBOUNDARY; ICOMPARE←ILEFT≥IBOUNDARY;
ICOMPARE←¬EQU(LEFT,BOUNDARY) END ;
RELOP ← TRYFAMILY(RELQ) ELSE IF RELOP < 0 THEN -1 ELSE -2 ;
LEFT ← BOUNDARY ; ILEFT ← IBOUNDARY ;
END "COMPARATORS" UNTIL RELOP < 0 ;
COMPARE ← IF RELOP=-1 THEN BOUNDARY ELSE CVS(ICOMPARE) ;
IF NOTOP = 0 THEN COMPARE ← IF TRUESTR(COMPARE) THEN "0" ELSE "-1" ;
NOTOP ← -1 ;
IF ANDOP < 0 OR TRUESTR(ALL) THEN IF FALSTR(ALL ← COMPARE) THEN ON ← FALSE ;
ANDOP ← TRYFAMILY(ANDQ) ELSE -1 ; ALL ← ALL ; comment SAIL bug -- force it to store;
END "CONJUNCTS" UNTIL ANDOP < 0 ;
ON ← WASONA ;
IF OROP < 0 OR FALSTR(ANY) THEN IF TRUESTR(ANY ← ALL) THEN ON ← FALSE ;
OROP ← TRYFAMILY(ORQ) ELSE -1 ; ANY ← ANY ; comment SAIL bug -- force it to store ;
END "DISJUNCTS" UNTIL OROP < 0 ;
ON ← WASONO ;
RETURN(DUMMYSTR ← ANY) ; comment, DUMMYSTR due to SAIL RECURSIVE STRING PROCEDURE bug (see DCS);
END "SIMPLE EXPRESSION" ;
STRING SIMPLE PROCEDURE DEFN(BOOLEAN SUBSTVARIABLES,FORFILE; INTEGER ARGS, IBASE) ;
BEGIN
STRING SEGMENT, IDENT, PSPCS, SPCS, FML, TXID, TX2 ; INTEGER SINDX, I, DEEP ; LABEL FORMAL ;
IF ITSCH(;) THEN PASS ; DEFINING ← NOT FORFILE ; comment, makes RD include line nos in result ;
IF ¬ITSCH(⊂) AND NOT(ITSCH($) AND NEXTSCH("("))
THEN BEGIN WARN("=","Missed ⊂ OR $( in definition") ; RETURN(NULL) END ;
DEEP ← 1 ; SINDX ← SHIGH ;
IF SHIGH+20>STSIZE THEN
BEGIN
SGROW(STBL,STBLIDA,STSIZE,100,"Definition") ;
SMAKEBE(STBLIDA, STBL) ; ZEROSTRINGS(100, STBL[STSIZE-99]) ;
END ;
EMPTYTHIS ; comment For page label switch in LABELREF ;
IF FORFILE THEN STBL[SINDX←SINDX+1] ← SRCLINE & "/" & SRCPAGE & TB & ALTMODE ;
IF EQU(INPUTSTR[1:2], RCBRAK&VT) THEN
BEGIN
STBL[SINDX ← SINDX + 1] ← CRLF & SRCLINE & "/" & SRCPAGE & TB ;
INPUTSTR ← INPUTSTR[3:∞] ;
END ;
WHILE DEEP DO
BEGIN "DEF BODY"
SEGMENT ← RD(DEFN!TABLE) ;
IF BRC = "⊂" ∨ BRC="$"∧INPUTSTR="("∧LOP(INPUTSTR)="(" THEN
BEGIN DEEP ← DEEP + 1 ; SEGMENT ← SEGMENT & "⊂" ; END
ELSE IF BRC = "⊃" ∨ BRC=")"∧INPUTSTR="$"∧LOP(INPUTSTR)="$" THEN
BEGIN DEEP ← DEEP - 1 ;
SEGMENT ← SEGMENT & (IF DEEP THEN "⊃" ELSE SP) ;
END
ELSE IF BRC = "∃" THEN SEGMENT ← SEGMENT & (IF DEEP>1 THEN BRC ELSE NULL) & RD(ONE!CHAR)
ELSE IF LENGTH(TXID←BRC) ∧
(LDB(SPCODE(BRC))=LCURLY ∨
LDB(SPCODE(BRC))=DOLLAR ∧ LDB(SPCODE(INPUTSTR))=LBRACK ∧
LENGTH(TXID←TXID&LOP(INPUTSTR))) THEN
IF SUBSTVARIABLES THEN
BEGIN "{..."
SPCS ← TXID & RD(TO!VISIBLE) ;
IDENT ← SCAN(INPUTSTR,ALPHA,DUMMY) ; PSPCS ← RD(TO!VISIBLE) ;
IF BRC = RCBRAK ∨ BRC="]"∧INPUTSTR[2 FOR 1]="$"THEN
BEGIN
LOPP(INPUTSTR) ;
IF BRC="]" THEN BEGIN TX2←"]$" ; LOPP(INPUTSTR) END ELSE TX2←RCBRAK ;
SEGMENT ← SEGMENT &
(IF FULSTR(IDENT) ∧ SIMLOOK(CAPITALIZE(IDENT))
AND SYMTYPE<MACROTYPE THEN TES 11/29/73 ;
IF SYMIX=IXPAGE THEN ALTMODE&"[@]"&
LABELREF(0,
IF SYMBOL=SYMPAGE THEN CTR!CHRS(IXPAGE)
ELSE PATT!CHRS(IXPAGE))
ELSE EVALV(IDENT, SYMIX, SYMTYPE)
ELSE SPCS & IDENT & PSPCS & TX2)
END
ELSE SEGMENT ← SEGMENT & SPCS & IDENT & PSPCS ;
END "{..."
ELSE SEGMENT ← SEGMENT & TXID
ELSE IF BRC = RCBRAK THEN
IF EQU(INPUTSTR[1:2], RCBRAK&VT) THEN ELSE SEGMENT ← SEGMENT & BRC
ELSE IF LDB(FAMILY(BRC)) = LETTQ THEN
BEGIN "LETTER"
IDENT ← (BRC+0) & SCAN(INPUTSTR, ALPHA, BRC) ;
FOR I ← 1 THRU ARGS DO IF EQU(FML←SYM[ITBL[IBASE+I]], TXID←CAPITALIZE(IDENT)) THEN
FORMAL: BEGIN IDENT ← VT & I ; DONE END
ELSE IF 1 ≤ LENGTH(TXID)-LENGTH(FML) ≤ 2 THEN
BEGIN "MAYBE UNDERLINED"
INTEGER L, R ;
L ← IF TXID="!" THEN 1 ELSE 0 ; R ← IF TXID[∞ FOR 1]="!" THEN 1 ELSE 0 ;
IF EQU(FML, TXID[1+L TO ∞-R]) THEN
BEGIN
IF L THEN SEGMENT ← SEGMENT & "!" ;
IF R THEN INPUTSTR ← "!" & INPUTSTR ;
GO TO FORMAL ;
END ;
END "MAYBE UNDERLINED" ;
SEGMENT ← SEGMENT & IDENT ;
END "LETTER"
ELSE SEGMENT ← SEGMENT & BRC ;
STBL[SINDX ← SINDX+1] ← SEGMENT ;
IF SINDX = SHIGH+20 THEN
BEGIN
SEGMENT ← STBL[SHIGH + 1] ;
FOR I ← SHIGH + 2 THRU SINDX DO BEGIN SEGMENT ← SEGMENT & STBL[I] ; STBL[I]←NULL; END;
SINDX ← SHIGH + 1 ; STBL[SINDX] ← SEGMENT ;
END ;
END "DEF BODY" ;
SEGMENT ← STBL[SHIGH+1] ; FOR I ← SHIGH+2 THRU SINDX DO SEGMENT ← SEGMENT & STBL[I] ;
IF FORFILE THEN SEGMENT ← SEGMENT & LF ;
DEFINING ← FALSE ; INPUTSTR ← ";" & INPUTSTR ; PASS ;
RETURN(SEGMENT) ;
END "DEFN" ;
RECURSIVE PROCEDURE PARAMS(INTEGER MOST; STRING ARRAY PRE,PAR,POST);
BEGIN comment, Reads arguments for various commands;
INTEGER I, PREWD, SOFAR ; STRING EXPR ;
LABEL RDPAR, SETPAR ;
BOOLEAN GOT ; DEFINE FIND = "FOR I ← 1 THRU MOST DO IF" ;
SOFAR ← I ← GOT ← 0 ;
WHILE SOFAR<MOST ∧ THISTYPE≠-TERQ ∧ THISTYPE≠MANTYPE DO
BEGIN "PARAMETER"
IF THISISID THEN
BEGIN "IDENTIFIER"
IF ITS(TO) ∧ I<MOST ∧ ITSV(PRE[I+1]) THEN BEGIN PASS; I←I+1; GO TO RDPAR END;
FIND ITSV(PRE[I]) ∨ ITSV(PRE[I]&"S") THEN
BEGIN "PRE WORD"
PASS ; IF GOT LAND TWO(I) THEN WARN("=",PRE[I]&" Twice") ;
GO TO RDPAR ;
END "PRE WORD" ;
END "IDENTIFIER" ;
FIND ¬GOT LAND TWO(I) ∧ NULSTR(PRE[I]) ∧ (I=1 ∨ NULSTR(PRE[I-1]) ∨ GOT LAND TWO((I-1))) THEN GO TO RDPAR ;
DONE ;
RDPAR:
PREWD ← I ;
EXPR ← IF EQU(PRE[I],"IN") ∧ FULSTR(PAR[I]) THEN SPASS(THISWD) comment COUNT...IN -- ;
ELSE IF ITSCH(⊂) THEN 0 & DEFN(FALSE, FALSE, 0, 0)
ELSE E(NULL,IF I=MOST∨FULSTR(POST[I]) THEN POST[I] ELSE PRE[I+1]) ;
IF FULSTR(POST[I]) THEN
IF ITSV(POST[I]) THEN PASS
ELSE BEGIN "GUESSED WRONG"
FIND ITSV(POST[I]) THEN BEGIN PASS ; GO TO SETPAR END ;
FIND NULSTR(POST[I]) THEN GO TO SETPAR ;
WARN("=",POST[PREWD] & "Missed.") ;
DONE ;
END "GUESSED WRONG" ;
SETPAR:
IF PRE[I]≠PRE[PREWD] THEN WARN("=",(IF FULSTR(POST[PREWD]) THEN POST[PREWD] ELSE PRE[I])& " Missed.") ;
IF GOT LAND TWO(I) THEN WARN("=","Duplicate Parameter "&PRE[I]&SP&EXPR&SP&POST[I])
ELSE SOFAR ← SOFAR + 1 ;
GOT ← GOT LOR TWO(I) ;
PAR[I] ← EXPR ;
IF ITSCH(",") THEN PASS ;
END "PARAMETER" ;
END "PARAMS" ;
RECURSIVE STRING PROCEDURE SIMPAR ;
RETURN(IF THISISCON THEN THISWD[2 TO ∞] ELSE IF THISISID THEN VEVAL ELSE NULL) ;
SIMPLE PROCEDURE FINPORTION ;
BEGIN
DBREAK ;
IF OLDPGIDA THEN NEXTPAGE ;
END "FINPORTION" ;
RECURSIVE PROCEDURE DAREA(BOOLEAN TITAREA) ;
BEGIN
INTEGER I, IX, SYMB, TEMP, A, B ;
PRELOAD!WITH "LINE", "TO", "CHAR", "TO", "IN", "COLUMN", "COLUMN" ;
OWN STRING ARRAY PRE[1:7] ; STRING ARRAY PAR[1:7] ;
PRELOAD!WITH NULL, NULL, NULL, NULL, NULL, "WIDE", "APART" ;
OWN STRING ARRAY POST[1:7] ;
DBREAK; DPASS ;
IF ¬THISISID THEN BEGIN WARN("=","AREA MUST HAVE NAME"); THISWD←"!DUMMY" END ;
SYMB ← SYMNUM(THISWD) ;
PASS ;
PARAMS(7, PRE, PAR, POST) ;
IF ¬ON THEN RETURN ;
BIND(DECLARE(SYMB, AREATYPE), IX←PUSHI(AREAWDS,AREATYPE)) ;
IF FULHIGH(IX)←NULSTR(PAR[1]) THEN BEGIN A←1 ; B←FHIGH END comment assume LINE 1 TO <frame height> ;
ELSE BEGIN A ← CVD(PAR[1]) ; B ← IF NULSTR(PAR[2]) THEN A ELSE CVD(PAR[2]) END ;
LINE1(IX) ← A MAX 1 ; LINECT(IX) ← B-A+1 MAX 1 ;
IF FULWIDE(IX)← NULSTR(PAR[3]) THEN BEGIN A←1 ; B←FWIDE END
ELSE BEGIN A ← CVD(PAR[3]) ; B ← IF NULSTR(PAR[4]) THEN A ELSE CVD(PAR[4]) END ;
CHAR1(IX) ← A MAX 1 ; CHARCT(IX) ← B←B-A+1 MAX 1 ;
TEXTAR(IX) ← IF TITAREA THEN 0 ELSE 1 ;
IF NULSTR(PAR[5]) THEN A ← 1 comment Assume IN 1 COLUMNS <charct> WIDE ;
ELSE BEGIN "COLUMNS"
A ← CVD(PAR[5]) ; comment How many ;
IF FULSTR(PAR[6]) THEN B ← CVD(PAR[6]) MIN B DIV A
ELSE B ← (B+( TEMP←IF FULSTR(PAR[7]) THEN CVD(PAR[7]) ELSE 5 )) DIV A - TEMP ;
END "COLUMNS" ;
COLCT(IX) ← A MAX 1 ; COLWID(IX) ← B MAX 1 ;
OLMAX ← OLMAX + A*LINECT(IX) ;
FOOTSTR(IX) ← PUSHS(1, NULL) ;
MARGINS(IX) ← FONTS(IX) ← 0 ; TES 11/15/73 ;
TFONT(IX) ← OFONT(IX) ← DEFAULTFONT ; TES 11/15/73 ;
END "DAREA" ;
SIMPLE PROCEDURE DBELOW ;
BEGIN
END "DBELOW" ;
RECURSIVE PROCEDURE DBLANKPAGE ;
BEGIN COMMENT LEAVE N BLANK PAGES WITHOUT AFFECTING THE PAGE NUMBER ;
INTEGER I, J, N ;
PASS ; N ← CVD(E("1", NULL)) ;
IF ¬ON THEN RETURN ;
DBREAK ;
IF OLDPGIDA THEN NEXTPAGE ;
IF INTER ≤ 0 THEN NOPORTION ;
FOR I ← 1 THRU N DO FOR J ← PHIGH, PWIDE, -10 DO WORDOUT(INTER, J) ;
END ;
SIMPLE PROCEDURE DCC ;
BEGIN
END "DCC" ;
RECURSIVE PROCEDURE DCLOSE ;
BEGIN
DBREAK ; PASS ;
IF ON THEN
IF THISTYPE=AREATYPE THEN CLOSEAREA(IX,FALSE)
ELSE IF IX=IXPAGE THEN comment, * * * * * * * * * * * * * ;
ELSE WARN("=","CLOSE What? "&SOMEINPUT) ;
PASS ;
END "DCLOSE" ;
SIMPLE PROCEDURE DCOMMANDCHARACTER ;
BEGIN
INTEGER X ;
INPUTSTR ← ";;" & INPUTSTR ; COMMENT couple extra semicolons to assure next line read right ;
PASS ; X ← SIMPAR ;
IF LENGTH(X) ≠ 1 THEN WARN("=","COMMAND CHARACTER must be a single character, not `"&X&"'")
ELSE IF ON THEN COMMAND!CHARACTER ← X ;
PASS ; PASS ; PASS ;
END "DCOMMANDCHARACTER" ;
SIMPLE PROCEDURE DCOUNT ;
BEGIN
INTEGER USYMB, INLINE ;
PRELOAD!WITH "FROM", "TO", "BY", "IN", "PRINTING" ;
OWN STRING ARRAY PRE[1:5] ; OWN STRING ARRAY PAR[1:5] ;
DPASS ; IF ¬THISISID THEN BEGIN WARN("=","Unit must have a name") ; THISWD ← "!DUMMY" END ;
USYMB ← SYMNUM(THISWD) ; PASS ; IF ITS(INLINE) THEN BEGIN INLINE←TRUE; PASS END ELSE INLINE←FALSE ;
PAR[1]←PAR[2]←PAR[3]←PAR[5]←NULL;
PAR[4] ← 0 ; PARAMS(5, PRE, PAR, NULLS) ;
IF ON THEN CREUNIT( INLINE,
IF NULSTR(PAR[1]) THEN 1 ELSE CVD(PAR[1]), comment, FROM -- ;
IF NULSTR(PAR[2]) THEN 18 ELSE CVD(PAR[2]), comment, TO -- ;
IF NULSTR(PAR[3]) THEN 1 ELSE CVD(PAR[3]), comment, BY -- ;
IF PAR[4] = 0 THEN 0 ELSE SYMNUM(PAR[4]), comment IN -- ;
IF NULSTR(PAR[5]) THEN "1" ELSE PAR[5], comment, PRINTING -- ;
USYMB ) ;
END "DCOUNT" ;
SIMPLE PROCEDURE DDEVICE ;
BEGIN PASS ;
IF DEVICE ≥ 0 THEN COMMENT IF <0, WAS SET BY /SWITCH, WHICH TAKES PRECEDENCE ;
IF ITS(MIC) THEN DEVICE←MIC ELSE IF ITS(TTY) THEN DEVICE←TTY
ELSE IF ITS(LPT) THEN DEVICE←LPT
ELSE IF ITS(XGP) THEN BEGIN DEVICE ← XGP; XCRIBL ← TRUE; OUTSTR(" XCRIBL!"); END
ELSE WARN("=","No such device: "&THISWD) ;
PASS ;
END "DDEVICE" ;
RECURSIVE PROCEDURE DCONDITIONAL ;
BEGIN
BOOLEAN WASON ;
WASON ← ON ; PASS ; ON ← TRUESTR("E(NULL,""THEN"")") ∧ WASON ;
IF ITS(THEN) THEN PASS ELSE WARN("=","Missed THEN in conditional statement "&THISWD) ;
STATEMENT;
IF ITS(ELSE) THEN BEGIN ON←WASON∧¬ON; PASS ; STATEMENT END ;
ON ← WASON ;
END "DCONDITIONAL" ;
INTERNAL SIMPLE PROCEDURE READFONT(INTEGER WHICH; STRING FILENAME, BFILENAME) ;
IF ON THEN
BEGIN "READFONT"
INTEGER SAVCW, CHAN, ZILCH, EOF;
IFC TENEX THENC STRING ELSEC INTEGER ENDC NAME, EXT, PPN ;
STRING XFILENAME ;
LABEL TRYAGAIN ; COMMENT SAIL DEFFICIENCY ;
IF NULSTR(BFILENAME) THEN
IFC TENEX THENC
BEGIN
NAME←CVFIL(FILENAME,EXT,PPN) ;
XFILENAME ← NAME & EXT ;
END
ELSEC
XFILENAME ← FILENAME TES 1/22/74 ;
ENDC
ELSE XFILENAME ← BFILENAME ;
SAVCW ← WHATIS(CW);
IF FONTFIL[WHICH] = 0 THEN FONTFIL[WHICH] ← CREATE(0,127);
DUMMY ← FONTFIL[WHICH] ;
IF SAVCW=WCW AND WHICH=DEFAULTFONT THEN SAVCW←DUMMY;
MAKEBE(DUMMY,CW);
OPEN(CHAN←GETCHAN,"DSK",'14, 2,0,0,ZILCH,EOF);
IFC TENEX THENC
LOOKUP(CHAN, FILENAME, FLAG) ;
IF FLAG THEN
BEGIN "HUNTFONT"
ENDC
TRYAGAIN: NAME←CVFIL(FILENAME,EXT,PPN);
WHILE TRUE DO
BEGIN "LKUPLOOP"
IF XLOOKUP(CHAN,NAME,EXT,0,PPN) THEN DONE;
IF EXT=0 THEN EXT←FONTEXT ELSE
IF PPN=0 THEN PPN←FONTPPN ELSE
IF FULSTR(BFILENAME) AND NOT EQU(FILENAME,BFILENAME) THEN
BEGIN
FILENAME ← BFILENAME ;
GO TRYAGAIN ;
END ELSE
BEGIN "NOTFOUND"
OUTSTR("Font file " & FILENAME & " not found. Read file: ");
IFC TENEX THENC
RELEASE(CHAN);
CHAN ← OPENFILE(NULL,"ROC") ;
DONE ;
ELSEC
FILENAME ← INCHWL ;
GO TRYAGAIN ;
ENDC
END "NOTFOUND";
END "LKUPLOOP";
IFC TENEX THENC
END "HUNTFONT" ;
ENDC
IFC VERSION=ITSVER THENC PJ 5/28/74 ;
WORDIN(CHAN);
FNTINF[WHICH]←WORDIN(CHAN);
IF WHICH=DEFAULTFONT THEN BASELINE←LDB(POINT(9,FNTINF[WHICH],17));
FNTINF[WHICH]←LDB(POINT(18,FNTINF[WHICH],35)); ie HEIGHT;
WHILE NOT EOF DO
IF (WORDIN(CHAN) LAND 1) THEN
BEGIN
DUMMY←LDB(POINT(18,DUMMY←WORDIN(CHAN),35));
CW[DUMMY]←LDB(POINT(18,CW[DUMMY]←WORDIN(CHAN),35));
END
ENDC
IFC VERSION=CMUVER THENC
WORDIN(CHAN);
FNTINF[WHICH]←WORDIN(CHAN); COMMENT RKJ 10-10-73;
WHILE NOT EOF DO
IF (WORDIN(CHAN) LAND 1) THEN
BEGIN DUMMY←WORDIN(CHAN); CW[DUMMY]←WORDIN(CHAN) END
ENDC
IFC VERSION=SAILVER THENC
ARRYIN(CHAN,CW[0],128);
FOR I ← 0 THRU 127 DO CW[I] ← CW[I] LSH -18;
WORDIN(CHAN); FNTINF[WHICH]←WORDIN(CHAN);
WORDIN(CHAN);
IF WHICH=DEFAULTFONT THEN BASELINE←WORDIN(CHAN);
ENDC
IFC VERSION=PARCVER THENC
BEGIN
EXTERNAL INTEGER GOGTAB;
INTEGER K,I;
IFC TENEX THENC
DEFINE JSYS="'104000000000", SFBSZ="JSYS '46";
K ← CVJFN(CHAN) ;
START!CODE "BYTE16"
MOVE 1,K; MOVEI 2,16; SFBSZ ;
END "BYTE16" ;
ELSEC
START!CODE "BYTE16" MOVE 1,GOGTAB; ADD 1,CHAN; MOVE 1,'13(1); comment now we have pointer to cdb;
HRRZ 1,2(1); comment now pointer to IBUF;
HRLI 2,'442000;
HLLM 2,1(1);
END "BYTE16";
ENDC
K←WORDIN(CHAN); WORDIN(CHAN);
FNTINF[WHICH]←WORDIN(CHAN); WORDIN(CHAN);
FOR I←1 THRU K DO WORDIN(CHAN);
K←(K MIN 128)-1;
FOR I←0 THRU K DO CW[I]←WORDIN(CHAN);
END;
ENDC;
IFC VERSION=SAILVER THENC CMDFILE ← CMDFILE & "/FONT#" & CVS(WHICH-1) & "=" & FILENAME ENDC;
TES 1/7/74 ADDED NEXT LINE: ; TES 1/22/74 PUT XFILENAME ;
FNTNAME[WHICH]←XFILENAME; HIFONT←WHICH MAX HIFONT ;
RELEASE(CHAN);
MAKEBE(SAVCW,CW);
END "READFONT";
INTERNAL SIMPLE PROCEDURE SWITCHFONT(INTEGER WHICH) ;
BEGIN TES 11/15/73 TO DO IT BY AREA ;
INTEGER NEWIX ;
IF AREAIXM AND FONTS(AREAIXM) < OLDIHED THEN
BEGIN TES FIRST CHANGE IN THIS BLOCK IN THIS AREA ;
NEWIX ← PUSHI(FONTWDS, FONTYPE) ;
AREAX(NEWIX) ← AREAIXM ;
OUTERX(NEWIX) ← FONTS(AREAIXM) ;
THISFONTX(NEWIX) ← THISFONT ;
OLDFONTX(NEWIX) ← OLDFONT ;
FONTS(AREAIXM) ← NEWIX ;
END ;
OLDFONT ← THISFONT;
IF THISFONT NEQ WHICH THEN
BEGIN
THISFONT ← WHICH;
WHICH ← FONTFIL[WHICH]; MAKEBE(WHICH,CW);
END ;
END ;
INTERNAL SIMPLE PROCEDURE SELECTFONT(INTEGER WHICH);
IF ON THEN
BEGIN "SELECTFONT"
INTEGER F;
DBREAK;
IF NOT XCRIBL OR LAST<4 THEN RETURN;
F←(IF WHICH<10 THEN (WHICH+"0") ELSE (WHICH+("A"-10)));
IF FONTFIL[WHICH]=0 THEN BEGIN WARN("=","Unknown font `"& F & "'");
RETURN END;
SWITCHFONT(WHICH) ; TES 11/14/73 SUBROUTINIZED ;
TES 11/15/73 erased: XGPCMD ← (FONTCHAR & "F") & F ;
END "SELECTFONT";
INTERNAL SIMPLE INTEGER PROCEDURE RFONT(INTEGER F) ;
RETURN( TES SUBROUTINIZED AND CASED 11/29/73 ;
IFC VERSION = SAILVER OR VERSION=ITSVER PJ 5/28/74 ; THENC
IF "1"≤F≤"9" THEN F←F-"0"
ELSE IF "A"≤F≤"Z" THEN F←F-("A"-10)
ELSE IF "a"≤F≤"z" THEN F←F-("a"-10)
ELSE -1
ENDC
IFC VERSION = PARCVER THENC
IF "1"≤F≤"9" THEN F←F-"0"
ELSE -1
ENDC
IFC VERSION = CMUVER THENC
IF "A"≤F≤"B" THEN F←F-("A"-10)
ELSE IF "a"≤F≤"b" THEN F←F-("a"-10)
ELSE IF "1"≤F≤"2" THEN F←F-"0"
ELSE -1
ENDC
) ;
SIMPLE PROCEDURE DFONT(BOOLEAN SELECT);
BEGIN "DFONT"
INTEGER F;
PASS;
IF LENGTH(THISWD)=1 AND THISTYPE GEQ 0 AND (F←RFONT(THISWD)) GEQ 0 THEN PASS
ELSE F ← RFONT(E(NULL,NULL)) ; TES 11/29/73 ;
IF F<0 THEN
BEGIN WARN("=","Illegal font `"&F&"'"); RETURN END;
IF SELECT THEN SELECTFONT(F) TES 1/22/74 ADDED OPTIONAL XGP FILENAME ;
ELSE READFONT(F,E(NULL,NULL), IF ITSCH(",") THEN PASS&E(NULL,NULL) ELSE NULL);
END "DFONT";
RECURSIVE PROCEDURE DFRAME(BOOLEAN BOXFRM) ;
BEGIN
INTEGER L, I ;
PRELOAD!WITH "HIGH", "WIDE" ; OWN STRING ARRAY POST[1:2];
STRING ARRAY PAR[1:2] ;
DAPART ; PASS ; PARAMS(2,NULLS,PAR,POST);
IF ON THEN
IF BOXFRM THEN BEGIN END
ELSE
BEGIN
PHIGH←FHIGH←IF NULSTR(PAR[1]) THEN 1 ELSE CVD(PAR[1]) ;
PWIDE←FWIDE←IF NULSTR(PAR[2]) THEN 1 ELSE CVD(PAR[2]) ;
IF OLDPGIDA THEN NEXTPAGE ;
L ← NULLAREAS ;
WHILE L DO BEGIN
I ← AREAIDA ; IDASSIGN(AREAIDA←L,THISAREA) ; L ← RH(INA) ;
OPEN!ACTIVE(DEFA) ← 0 ; GOAWAY(AREAIDA) ; IF (AREAIDA←I) THEN IDASSIGN(AREAIDA,THISAREA) ;
END ;
NULLAREAS ← 0 ;
END ;
END "DFRAME" ;
SIMPLE PROCEDURE DINDENT ;
BEGIN
STRING X ;
DBREAK ; PASS ; X ← E(NULL,NULL) ; IF ON ∧ FULSTR(X) THEN FIRSTIM ← CVD(X) ;
IF ITSCH(",") THEN BEGIN PASS ; X←E(NULL, NULL) END ELSE X←NULL ;
IF ON ∧ FULSTR(X) THEN RESTIM←CVD(X) ;
IF ITSCH(",") THEN BEGIN PASS ; X←E(NULL, NULL) END ELSE X←NULL ;
IF ON ∧ FULSTR(X) THEN RIGHTIM←CVD(X) ;
END "DINDENT" ;
SIMPLE PROCEDURE DINSERT ;
BEGIN
INTEGER CHAN, PIX, ROTTEN ;
IF ON THEN BEGIN TES 4/11/74;
FINPORTION ;
IF INTER ≥ 0 THEN
BEGIN FOR DUMMY←1 THRU 5 DO WORDOUT(INTER,-20) ; RELEASE(INTER) ; RELEASE(SINTER) ; SINTER←INTER←-1 END ;
END ;
DO BEGIN "COLLATE"
DPASS ; IF ¬THISISID THEN BEGIN WARN("=","Unnamed INSERT Portion!") ; RETURN END ;
IF ON THEN
BEGIN ROTTEN ← FALSE ;
IF THISTYPE ≠ PORTYPE THEN
BEGIN
BIND(SYMB←DECLARE(SYMB, PORTYPE), PIX ← PUTI(4, -5));
PORSTR(PIX) ← PUTS(NULL) ; PUTS(NULL) ; TES 3/21/74;
END
ELSE IF (CHAN ← PORCH(PIX ← IX)) = -1 THEN BEGIN WARN("=","Can't INSERT FOOT!"); ROTTEN←TRUE END
ELSE IF ¬(0 ≤ CHAN ≤ 15) THEN BEGIN WARN("=","Can't INSERT passed Portion "&THISWD) ; ROTTEN←TRUE END ;
IF ¬ROTTEN THEN BEGIN PORSEQ(SEQPORT) ← PIX ; PORSEQ(SEQPORT ← PIX) ← -1 END ;
PASS ;
END ;
END "COLLATE" UNTIL ¬ITSCH(",") ;
END "DINSERT" ;
SIMPLE PROCEDURE DLET ;
BEGIN
INTEGER LOC ; LABEL BADLET ;
DPASS ; IF THATISID THEN BEGIN THATWD ← THISWD & THATWD ; DPASS END ; LOC ← SYMB ;
IF ¬THISISID THEN GO TO BADLET ; PASS ; IF ¬ITSCH(=) THEN GO TO BADLET ; DPASS ;
IF THISTYPE≠MANTYPE AND THATISID THEN BEGIN THATWD←THISWD&THATWD ; PASS END ;
IF THISTYPE≠MANTYPE THEN GO TO BADLET ; IF ON THEN BIND(LOC←DECLARE(LOC, MANTYPE), IX) ; PASS ;
RETURN ;
BADLET: WARN("=","LET <ID>=<RESWD>, please!") ; DO PASS UNTIL THISISID ∨ THISTYPE=-TERQ ;
END "DLET" ;
SIMPLE PROCEDURE DLOCK ;
BEGIN
END "DLOCK" ;
SIMPLE PROCEDURE DLOCAL ;
DO BEGIN
DPASS ;
IF THISISID THEN
BEGIN
IF ON THEN
BIND(SYMB←DECLARE(SYMB, LOCALTYPE), IX←PUSHS(1,NULL)) ;
PASS ;
END
ELSE BEGIN WARN("=","LOCAL declaration missing identifier"); IF THISTYPE≠TERQ THEN PASS END ;
END UNTIL ¬ITSCH(",") ;
SIMPLE PROCEDURE DMACRO(BOOLEAN ODDONE) ;
BEGIN COMMENT, OLD VERSION NOT GARBAGED BUT COULD BE ;
INTEGER SIHIGH, MIX, ARGS, J, NAMES, NAME ; BOOLEAN ROTTEN ;
SIHIGH ← IHIGH ; DPASS ; IF ¬THISISID THEN BEGIN WARN("=","Macro name not identifier") ; RETURN END ;
IF THATISID THEN BEGIN "TWO WORD" THISWD ← THISWD & SP & THATWD ; RDENTITY ; END "TWO WORD" ;
PUTI(1, SYMNUM(THISWD)) ; PASS ;
IF ITSCH("(") THEN
BEGIN "FORMALS"
ROTTEN ← FALSE ; THISWD ← "," ; NAMES ← 0 ;
DO BEGIN
IF ITSCH(",") THEN DPASS
ELSE BEGIN WARN("=","Missed comma in macro formal list") ; ROTTEN←TRUE END ;
IF ITSCH(ε) THEN BEGIN DPASS ; NAME ← 0 ; END ELSE NAME ← 1 ;
IF ¬THISISID THEN BEGIN WARN("=","Formal parameters must be identifiers") ; ROTTEN←TRUE END
ELSE BEGIN PUTI(1, SYMB) ; NAMES ← 2*NAMES + NAME ; DPASS END ;
END
UNTIL ITSCH(")") ∨ ROTTEN ;
IF ITSCH(")") THEN PASS ;
END "FORMALS" ;
IF ROTTEN ∨ ¬ON THEN BEGIN IHIGH ← SIHIGH ; DEFN(FALSE, FALSE,0,0) ; RETURN END ;
ARGS ← IHIGH - SIHIGH - 1 ; BIND(DECLARE(ITBL[SIHIGH+1], MACROTYPE), MIX←PUSHI(MACROWDS,MACROTYPE)) ;
NUMARGS(MIX) ← ARGS ; ODDMAC(MIX) ← ODDONE ; BODY(MIX) ← PUSHS(1,DEFN(FALSE, FALSE,ARGS,SIHIGH+1)) ;
IHIGH ← SIHIGH ; NAMEPAR(MIX) ← NAMES ;
END "DMACRO" ;
SIMPLE PROCEDURE DMARGINS(BOOLEAN INWARD) ;
BEGIN
STRING S ; INTEGER L, R, W, ARIX, OLDIX, NEWIX ;
IF ON THEN DBREAK ;
ARIX ← IF AREAIXM THEN AREAIXM ELSE IXTEXT ; OLDIX ← MARGINS(ARIX) ; PASS ;
S ← IF THISTYPE > INTERNTYPE ∨ THISTYPE=-TERQ ∨ NEXTSCH(←) ∨ NEXTSCH(:) THEN NULL
ELSE E(NULL, NULL) ;
IF FULSTR(S) ∨ ITSCH(",") THEN
BEGIN "HAS PARAMS"
L ← IF FULSTR(S) THEN CVD(S) ELSE 0 ;
IF ITSCH(",") THEN BEGIN PASS ; R ← CVD(E("0",NULL)) END ELSE R ← 0 ;
IF ¬ON THEN RETURN ;
MARGINS(ARIX) ← NEWIX ← PUSHI(MARGWDS, MARGTYPE) ; W ← COLWID(ARIX) ;
LMARG ← (IF OLDIX THEN LMARGX(OLDIX) ELSE 0) + INWARD*L MAX 0 MIN W-1 ;
RMARG ← (IF OLDIX THEN RMARGX(OLDIX) ELSE W) - INWARD*R MIN W MAX LMARG+1 ;
LMARGX(NEWIX) ← LMARG ; RMARGX(NEWIX) ← RMARG ;
AREAX(NEWIX) ← ARIX ; OLD!MARGX(NEWIX) ← OLDIX ;
END "HAS PARAMS"
ELSE IF ¬ON THEN RETURN
ELSE IF OLDIX THEN
BEGIN "UNNEST"
AREAX(OLDIX) ← 0 ; comment, so ENDBLOCK won't use it ;
MARGINS(ARIX) ← NEWIX ← OLD!MARGX(OLDIX) ;
LMARG ← IF NEWIX THEN LMARGX(NEWIX) ELSE 0 ;
RMARG ← IF NEWIX THEN RMARGX(NEWIX) ELSE COLWID(ARIX) ;
IF OLDIX = IHED THEN IHED ← IHED - 1 - MARGWDS ;
END "UNNEST"
ELSE WARN("=","Extra "&(IF INWARD>0 THEN "NARROW" ELSE "WIDEN")&" in Margin Nest") ;
END "DMARGINS" ;
RECURSIVE PROCEDURE DNEXT ;
BEGIN
COMMENT Already PASSed "NEXT" ;
IF ¬THISISID ∨ (THISTYPE ≠ UNITTYPE ∧ THISTYPE ≠ PUNITTYPE) THEN WARN("=","NEXT what?")
ELSE IF ON THEN IF IX=IXPAGE THEN NEXTPAGE ELSE USTEP(SYMB, IX) ;
PASS ;
END "DNEXT" ;
SIMPLE PROCEDURE DPACK ;
BEGIN
END "DPACK" ;
RECURSIVE PROCEDURE DPICHAR ;
BEGIN TES 11/29/73 ;
INTEGER KEY, IX, F, N ; STRING S ;
INPICHAR ← TRUE ;
PASS ;
KEY ←E(NULL,NULL) ;
IF ITSCH("(") THEN
BEGIN COMMENT TURN ON ;
PASS ;
DO S ← S & E(NULL,NULL) UNTIL ITSCH(")") ;
PASS ;
IF ITS(WIDTH) THEN
BEGIN PASS ;
IF ITS(OF) THEN BEGIN PASS ; F←'177; N←CVD(E(NULL,NULL)) END
ELSE BEGIN F←CVD(E(NULL,NULL)); N←F MOD '177; F←F DIV '177 END
END
ELSE BEGIN F←'177 ; N ← SP END ;
S ← F & N & S ;
END
ELSE S ← NULL ; COMMENT TURN OFF ;
IX ← PUSHI(PIWDS,PITYPE) ;
PIKEY(IX) ← KEY ; PIVAL(IX) ← PUSHS(1, PICHAR[KEY]) ;
PICHAR[KEY] ← S ;
INPICHAR ← FALSE ;
END "DPICHAR" ;
SIMPLE PROCEDURE DPORTION ;
BEGIN
INTEGER CHAN, PSIX, PIX ; STRING IFIL ; LABEL WASFWD ;
DPASS ; IF ¬THISISID THEN BEGIN WARN("=","Unnamed PORTION!") ; RETURN END ;
IF ¬ON THEN BEGIN PASS ; RETURN END ;
FINPORTION ;
IF THISTYPE ≠ PORTYPE THEN
BEGIN
BIND(SYMB←DECLARE(SYMB, PORTYPE), PIX ← PUTI(4, -2)) ;
PORSTR(PIX) ← PUTS(NULL) ; PUTS(NULL);
PORSEQ(PIX) ← 0 ;
END
ELSE IF 0 ≤ (CHAN ← PORCH(PIX ← IX)) THEN BEGIN RELEASE(CHAN) ; PORCH(PIX) ← -3 ; GO TO WASFWD END
ELSE IF CHAN = -1 THEN BEGIN WARN("=","Can't declare PORTION FOOT!") ; PASS ; RETURN END
ELSE IF CHAN ≠ -5 THEN WARN("=","PORTION "&THISWD&" already declared!")
ELSE IF PORSEQ(THISPORT) ≠ PIX THEN
BEGIN PORCH(PIX) ← -2 ; COMMENT ADDED FEB 6, 1973 ;
WASFWD: BEGIN
IF INTER ≥ 0 THEN
BEGIN FOR DUMMY←1 THRU 5 DO WORDOUT(INTER,-20) ; RELEASE(INTER) ; RELEASE(SINTER) END ;
INTER ← SINTER ← -1 ;
END ;
END ;
IF INTER < 0 THEN
BEGIN
PSIX ← PORSTR(PIX) ;
IFC TENEX THENC
IFIL ← CVS(INTERS←INTERS+1) ; PORINT(PSIX) ← IFIL ;
INTER ← WRITEON(TRUE,IFILENAME&OCTEXT&IFIL) ;
SINTER← WRITEON(FALSE,IFILENAME&TXTEXT&IFIL) ;
ELSEC
IFIL ← "PUI"&CVS(INTERS←INTERS+1) ;
PORINT(PSIX)←IFIL ;
INTER←WRITEON(TRUE,IFIL&PUIEXT) ; SINTER←WRITEON(FALSE,IFIL&"S"&PUIEXT) ;
ENDC
END ;
IF PORSEQ(PIX) = 0 THEN
BEGIN
PORSEQ(SEQPORT) ← PIX ;
SEQPORT ← PIX ;
END ;
THISPORT ← PIX ; PORTS ← PORTS + 1 ;
PASS ;
END "DPORTION" ;
SIMPLE PROCEDURE DRECEIVE ;
BEGIN
STRING A ;
IF THATISCON ∧ 1≤ LENGTH(THATWD)-1 ≤2 THEN BEGIN PASS ; A ← THISWD[2 TO ∞] END
ELSE A ← NULL ;
IF ON THEN RECEIVE(THISPORT, A) ; PASS ;
END "DRECEIVE" ;
SIMPLE PROCEDURE DRESPONSE(INTEGER COMDWD) ;
BEGIN
INTEGER ARGS, SIHIGH, L1, L2, SIG, CLU, VARI, S, A, RIX, J, TYP, XIX, OLDIX ;
STRING PHR, X, BOD ; BOOLEAN ROTTEN, HASBODY ;
SIMPLE PROCEDURE RESPREPL ;
BEGIN
RIX ← PUSHI(RESPWDS, RESPTYPE) ;
NEXT!RESP(RIX) ← LLPOST ; OLD!RESP(RIX) ← LLTHIS ;
END "RESPREPL" ;
ROTTEN ← FALSE ; ARGS ← 0 ; SIHIGH ← IHIGH ;
IF COMDWD = 1 THEN
BEGIN "AT"
PASS ;
IF ITS(PAGEMARK) THEN BEGIN VARI←2 ; CLU←0 ; L1←FF ; SIG←FF ROT -7 ; PASS END
ELSE BEGIN
X ← SIMPAR ; L1 ← X ;
IF NULSTR(X) THEN BEGIN VARI←2 ; CLU←0 ; L1←CR ; SIG←CR ROT -7 ; PASS END
ELSE IF THISWD[1 FOR 1]="0" THEN BEGIN VARI←1 ; CLU←CVD(X) ; PASS END
TES 11/15/73: TEST ABOVE USED TO BE "0" LEQ L1 LEQ "9".
ALSO, TOOK OUT "PHRASE RESPONSE", VARI=0;
ELSE BEGIN VARI ← 2 ; L1 ← X ; SIG ← CVASC(X) ; CLU ← LENGTH(X) ;
DPASS ; A ← 0 ;
WHILE ¬(ITSCH(;) ∨ ITSCH(⊂)) DO
BEGIN
IF ¬THISISID THEN
BEGIN
WARN("=","Argument must be identifier.") ;
ROTTEN←TRUE ;
END ;
S←SYMB ; PASS ; IF LENGTH(X←SIMPAR)≠1 THEN WARN("=","Separator 1 character only");
PUTI(1, S) ; A ← A LSH 7 LOR X ; DPASS ;
END ;
ARGS ← IHIGH - SIHIGH ;
END ;
END ;
END "AT"
ELSE BEGIN
PASS ; IF ¬THISISID THEN BEGIN WARN("=","BEFORE/AFTER need area/unit name") ; ROTTEN←TRUE END
ELSE BEGIN VARI←IF COMDWD THEN 3 ELSE 4; CLU←SYMB; TYP←THISTYPE; XIX←IX; PASS END ;
END ;
BOD ← DEFN(FALSE, FALSE,ARGS,SIHIGH) ; OLDIX ← RIX ← -1 ;
IF ROTTEN ∨ ¬ON THEN BEGIN IHIGH ← SIHIGH ; RETURN END ;
X ← BOD ; SCAN(X, TO!NON!SP, HASBODY) ; IF ¬HASBODY THEN BOD ← NULL ;
CASE VARI-1 MIN 2 OF
BEGIN
ie 0... Phrase TES 11/15/73 removed this case ;
ie 1 ... Inset ;IF FINDINSET(CLU) THEN
IF DEPTH!RESP(LLTHIS) < DEPTH THEN
BEGIN
RESPREPL ;
IF LLPREV<0 THEN LEADRESPS←RIX ELSE NEXT!RESP(LLPREV) ← RIX ;
END
ELSE IF HASBODY THEN OLDIX ← RIX ← LLTHIS TES 11/29/73 OLDIX;
ELSE BEGIN
OLDIX ← LLTHIS ; TES 11/29/73 ;
LLSKIP(LEADRESPS, NEXT!RESP)
END
ELSE BEGIN
RIX←PUSHI(RESPWDS,RESPTYPE) ;
LLINS(LEADRESPS,NEXT!RESP,RIX) ;
END ;
ie 2 ... Signal;BEGIN S ← 0 ; comment Old response of same signal: >0 for outer block, <0 same block;
IF FINDSIGNAL(SIG) THEN
BEGIN
S ← IF DEPTH!RESP(LLTHIS) < DEPTH THEN LLTHIS ELSE -LLTHIS ;
IF S<0 THEN OLDIX ← LLTHIS; TES 11/29/73 ;
LLSKIP(SIGNALD[L1], NEXT!RESP) ; LLTHIS ← LLPOST ;
END ;
IF HASBODY ∨ S > 0 THEN
BEGIN
RIX←PUSHI(SIGWDS,RESPTYPE); SIGNAL(RIX)←SIG ; NUMARGS(RIX) ← ARGS ;
LLINS(SIGNALD[L1], NEXT!RESP, RIX) ; RESP!SEP(RIX) ← A ;
IF S = 0 THEN SIG!BRC ← (SIG LSH -29) & SIG!BRC ; OLD!RESP(RIX) ← S MAX 0;
END ;
IF NULSTR(BOD) ∧ S THEN
BEGIN
X ← NULL ;
WHILE FULSTR(SIG!BRC) ∧ (A ← LOP(SIG!BRC)) ≠ L1 DO X ← X & A ;
SIG!BRC ← X & SIG!BRC ;
END ;
SETBREAK(TEXT!TBL, TEXT!BRC&SIG!BRC, NULL, "IS") ;
END ;
ie 3,4... AFTER/BEFORE area|unit ;
IF FINDTRAN(CLU, VARI) THEN
IF DEPTH!RESP(LLTHIS) < DEPTH THEN
BEGIN
RESPREPL ;
IF LLPREV < 0 THEN WAITRESP←RIX ELSE NEXT!RESP(LLPREV) ← RIX ;
END
ELSE IF HASBODY THEN OLDIX ← RIX ← LLTHIS
ELSE BEGIN
OLDIX ← LLTHIS ; TES 11/29/73 ;
LLSKIP(WAITRESP, NEXT!RESP)
END
ELSE BEGIN
RIX←PUSHI(RESPWDS,RESPTYPE) ;
LLINS(WAITRESP,NEXT!RESP,RIX) ;
END ;
END ;
IF OLDIX GEQ 0 THEN SSTK[BODY(OLDIX)] ← NULL ; TES 11/29/73 GC ;
IF RIX ≥ 0 THEN
BEGIN
CLUE(RIX) ← CLU ; VARIETY(RIX) ← VARI ;
BODY(RIX) ← PUSHS(1,BOD) ; DEPTH!RESP(RIX) ← DEPTH ;
END ;
END "DRESPONSE" ;
SIMPLE PROCEDURE DREQUIRE ;
BEGIN
STRING F ;
PASS ; F ← E(NULL, "SOURCE!FILE") ;
IF ¬EQU(THISWD[1 TO 6],"SOURCE") THEN WARN("=","REQUIRE -- SOURCE!FILE only!") ;
IF FULSTR(F) ∧ ON THEN SWICHF(F) ; PASS ;
END "DREQUIRE" ;
SIMPLE PROCEDURE DSEND ;
BEGIN
INTEGER PIX; STRING FI ;
INTEGER SIMPLE PROCEDURE OPORT ;
BEGIN INTEGER CH ; CH←WRITEON(FALSE,
IFC TENEX THENC IFILENAME&GENEXT&(FI←THISWD) ELSEC
(FI←(CVS(PORTS←PORTS+1)&THISWD)[1 TO 5])&PUGEXT ENDC) ;
RETURN(CH) ; END "OPORT" ;
PASS ; IF ¬THISISID THEN BEGIN WARN("=","SEND Where?") ; RETURN END ;
IF ¬ON THEN BEGIN PASS ; DEFN(FALSE, FALSE,0,0) ; RETURN END ;
IF THISTYPE ≠ PORTYPE THEN
BEGIN
BIND(SYMB←DECLARE(SYMB, PORTYPE), PIX ← PUTI(4, OPORT) ) ;
PORSTR(PIX) ← PUTS(NULL) ; PUTS(NULL) ;
PORSEQ(PIX) ← 0 ; PORFIL("PORSTR(PIX)") ← FI ;
END
ELSE IF PORCH(PIX←IX)=-5 THEN
BEGIN PORCH(PIX)←OPORT ; PORFIL("PORSTR(PIX)")←FI END ;
PASS ;
SEND(PIX, DEFN(TRUE,PORCH(PIX)≠-1,0,0)) ;
END "DSEND" ;
SIMPLE PROCEDURE DSHOW ;
BEGIN
END "DSHOW" ;
SIMPLE PROCEDURE DSUPERIMPOSE ;
BEGIN
INTEGER N ;
DBREAK ; PASS ; N ← CVD(E("0",NULL)) MIN 50 ;IF N<1 THEN N←50 ; IF ¬ON THEN RETURN ;
TWEENLFM ← N-1; SINCELFM ← 0; BREAKM ← 5;
END "DSUPERIMPOSE" ;
RECURSIVE PROCEDURE DSKIP(BOOLEAN GRPSKIP) ;
BEGIN
BOOLEAN GM ;
DBREAK ; PASS ;
IF GRPSKIP THEN BEGIN GM←GROUPM ; GROUPM ←1 ; END ;
IF ITS(TO) THEN
BEGIN "SKIP TO"
DAPART ; PASS ;
IF ITS(COLUMN) THEN BEGIN PASS; TOCOLUMN(CVD(E(CVS(COL+1),NULL))) END
ELSE BEGIN IF ITS(LINE) THEN PASS ; TOLINE(CVD(E("1", NULL))) END ;
END "SKIP TO"
ELSE SKIPLINES(IF THISTYPE>INTERNTYPE ∨ THISTYPE=-TERQ ∨ NEXTSCH(←) ∨ NEXTSCH(:)
THEN 1 ELSE CVD(E("1", NULL))) ;
IF GRPSKIP ∧ GM = 0 THEN DAPART ;
END "DSKIP" ;
SIMPLE PROCEDURE DTABS ;
BEGIN
INTEGER NUMB, I ; BOOLEAN TOO ;
IF ON THEN TABSORT[1] ← TWO(33) ; TOO ← FALSE ;
DO BEGIN
PASS ; NUMB ← CVD(E("-9999", NULL)) MIN 9999 ;
IF ON THEN
BEGIN
FOR I ← 1 THRU 27 DO IF TABSORT[I] ≥ NUMB THEN DONE ; IF I>27 THEN TOO←TRUE;
IF ¬TOO ∧ NUMB > -9999 THEN
IF TABSORT[I] > NUMB THEN DO BEGIN TABSORT[I] ↔ NUMB ; I ← I + 1 END UNTIL TABSORT[I-1]=TWO(33) ;
END ;
END
UNTIL ¬ITSCH(",") ;
IF TOO THEN WARN("=","Too many Tab Stops") ;
END "DTABS" ;
SIMPLE PROCEDURE DTURN(BOOLEAN TURNON) ;
BEGIN
comment TURN ON|OFF {"c" [FOR "c"]},... ;
INTEGER C1, C2 ; STRING S1, S2 ;
PASS ;
IF THISTYPE>INTERNTYPE ∨ THISTYPE=-TERQ ∨ NEXTSCH(:) ∨ NEXTSCH(←) THEN
BEGIN "TURN BACK"
C1 ← IHED ;
WHILE C1>0 ∧ (C2←IXTYPE(C1))≠MODETYPE ∧ (C2≠TURNTYPE ∨ ISTK[C1-1]<0) DO C1 ← IXOLD(C1) ;
IF C2=TURNTYPE THEN DO BEGIN TURN((C2←ISTK[C1-1]) LSH -7,C2 LAND '177,1) ;
ISTK[C1-1] ← -2 ; C1 ← IXOLD(C1) END UNTIL C1≤0 ∨ IXTYPE(C1)≠TURNTYPE ∨ ISTK[C1-1]<0 ;
END "TURN BACK"
ELSE BEGIN "TURN CHARS"
PUSHI(TURNWDS, TURNTYPE) ; ISTK[IHED-1] ← -1 ;
DO BEGIN
IF ITSCH(",") THEN PASS ;
S1 ← IF NOT ITS(TAB) THEN SIMPAR ELSE TB ; PASS ;
COMMENT 2/27/73 TES ;
IF ITS(FOR) THEN BEGIN PASS ; S2 ← SIMPAR ; PASS END ELSE IF TURNON THEN S2 ← S1 ELSE S2 ← NULL ;
IF ON THEN
BEGIN
IF 0 ≠ LENGTH(S2) ≠ LENGTH(S1) THEN
WARN(NULL,"Strings each side of FOR are unequal length") ;
WHILE FULSTR(S1) DO
TURN(LOP(S1), IF FULSTR(S2) THEN LOP(S2) ELSE 0, TURNON) ;
END ;
END UNTIL ¬ITSCH(",") ;
END "TURN CHARS" ;
END "DTURN" ;
SIMPLE PROCEDURE DUSERERR ; RKJ: 1-9-74;
BEGIN "DUSERERR"
STRING USER!MESSAGE;
PASS;
USER!MESSAGE ← E(NULL,NULL);
IF ON THEN WARN("=",USER!MESSAGE);
END "DUSERERR";
INTEGER SIMPLE PROCEDURE COUNTERSTMT ;
IF ITS(NEXT) THEN
BEGIN
INTEGER USYMB ; ie, unit name symbol number ;
PASS ; USYMB←IF THISTYPE=UNITTYPE THEN SYMB ELSE IF THISTYPE=PUNITTYPE THEN -SYMB ELSE TWO(20) ;
DNEXT ; RETURN(USYMB) ;
END
ELSE RETURN(0) ;
BOOLEAN SIMPLE PROCEDURE LABELDEF ;
IF ¬NEXTSCH(:) THEN RETURN(FALSE)
ELSE IF ¬ON THEN
BEGIN
WHILE THISISID ∧ NEXTSCH(:) DO BEGIN PASS ; PASS END ;
IF ¬ COUNTERSTMT THEN E(0, 0) ; RETURN(TRUE) ;
END
ELSE
BEGIN
INTEGER LINK, PTR, PLIGHT, USYMB, WASSYMB, VALPTR ; STRING DEFVAL ;
SIMPLE PROCEDURE CHECK!CONSISTENCY ;
IF WASSYMB ∧ USYMB≠0 ∧ LDB(IXN(WASSYMB)) ≠ LDB(IXN(ABS(USYMB))) THEN
WARN("=","Label "&SYM[LINK]&" was cross-referenced as a "&
SYM[WASSYMB]&" but is being defined as a "&
SYM[ABS(USYMB)]) ;
LINK ← 0 ;
DO BEGIN "MULTIPLE LABELS"
PTR ← SYMNUM(THISWD&":") ; BYTEWD ← NUMBER[PTR] ;
IF BYTEWD=0 OR ( PLIGHT ← LDB(PLIGHTWD(BYTEWD)) ) = 1 THEN
BEGIN NUMBER[PTR] ← BYTEWD LSH 13 LOR LINK ; LINK ← PTR END
ELSE WARN("=","Label "&SYM[PTR]&" is already defined as "&
(IF PLIGHT=2 THEN STBL[IX] ELSE "a recent page number")) ;
PASS ; PASS ;
END "MULTIPLE LABELS"
UNTIL ¬(THISISID ∧ NEXTSCH(:)) ;
IF LINK = 0 THEN RETURN(TRUE) ; TES 11/29/73 ;
DEFVAL ← IF (USYMB←COUNTERSTMT)=0 THEN E(0,0)
ELSE IF USYMB>TWO(13) THEN "??"
ELSE IF USYMB>0 THEN C! ELSE !;
IF EQU(DEFVAL,0) OR USYMB = SYMPAGE THEN
DO BEGIN "PAGE LABELS"
NUMBER[LINK] ↔ PLBL ; WASSYMB ← PLBL LSH -13 ;
CHECK!CONSISTENCY ;
PLBL ↔ LINK ; LINK ← LINK LAND '17777 ; PLBL ← -PLBL ;
END "PAGE LABELS"
UNTIL LINK=0
ELSE BEGIN "OTHER UNIT"
VALPTR ← 2 ROT -2 LOR PUTS(DEFVAL&(IF XCRIBL THEN ALTMODE&CVS(XLENGTH(DEFVAL)) ELSE NULL)) ;
DO BEGIN
PTR ← VALPTR ; NUMBER[LINK] ↔ PTR ; WASSYMB ← PTR LSH -13 ;
CHECK!CONSISTENCY ;
LINK ← PTR LAND '17777 ;
END
UNTIL LINK=0 ;
END "OTHER UNIT" ;
RETURN(TRUE) ;
END "LABELDEF" ;
RECURSIVE BOOLEAN PROCEDURE ASSIGNMENT ;
IF NEXTSCH(←) THEN
BEGIN
VASSIGN(SYMB, THISTYPE, IX, E(SPASS(PASS), 0)) ;
IF ITSCH(;) THEN PASS ; RETURN(TRUE) ;
END
ELSE RETURN(FALSE) ;
BOOLEAN SIMPLE PROCEDURE EMPTYCHUNK ;
RETURN(IF ITSCH(;) THEN IPASS(TRUE) ELSE FALSE) ;
BOOLEAN SIMPLE PROCEDURE NONSENSE(BOOLEAN VALID) ;
BEGIN
IF VALID THEN WARN("=","Can't make sense out of: "&SOMEINPUT) ;
PASS ; RETURN(FALSE) ;
END "NONSENSE" ;
RECURSIVE BOOLEAN PROCEDURE COMMAND ;
BEGIN
DEFINE DB(WHAT) = "BEGIN IF ON THEN WHAT; PASS END",
BDB(WHAT)="BEGIN IF ON THEN BEGIN DBREAK; WHAT END; PASS END";
IF THATISID ∧ SYMLOOK(THISWD&THATWD) ∧ LDB(TYPEN(SYMBOL))=MANTYPE THEN
BEGIN THISWD ← SYM[SYMB←SYMBOL] ; THISTYPE ← MANTYPE ;
IX ← LDB(IXN(SYMB)) ; RDENTITY ; END
ELSE IF THISTYPE ≠ MANTYPE THEN RETURN(FALSE) ;
CASE IX OF
BEGIN COMMENT COMMANDS ; comment THISWD is command word.;
ie ADJUST ; BDB(JUSTM←1) ;
ie AFTER ; DRESPONSE(2) ;
ie APART ; BEGIN DAPART ; PASS END ;
ie AREA ; DAREA(FALSE) ;
ie AT ; DRESPONSE(1) ;
ie BEFORE ; DRESPONSE(0) ;
ie BEGIN ; BEGIN BEGINBLOCK(FALSE, IF ENDCASE=2 ∧ ON THEN -1 ELSE 1,
IF THATISCON THEN SPASS(THATWD[2 TO ∞]) ELSE NULL) ; PASS END ;
ie BELOW ; DBELOW ;
ie BLANK PAGE ; DBLANKPAGE ;
ie BOX FRAME ; DFRAME(TRUE) ;
ie BREAK ; BEGIN DBREAK ; PASS END ;
ie CC ; DCC ;
ie CENTER ; BDB(BREAKM←4) ;
ie CLOSE ; DCLOSE ;
ie COMMAND CHARACTER ; DCOMMANDCHARACTER ;
ie COMMENT ; BEGIN IMPOSSIBLE("COMMAND") ; PASS END ;
ie COMPACT ; DB(SPACEM←IF FILL THEN 1 ELSE 2) ;
ie CONTINUE ; BEGIN DBREAK ; NOPGPH ← 1 ; PASS END ;
ie COUNT ; DCOUNT ;
ie CRBREAK ; DB(CRBM←1) ;
ie CRSPACE ; DB(CRBM←0) ;
ie DEVICE ; DDEVICE ;
ie END ; CASE IF STARTS THEN 0 ELSE ENDCASE OF BEGIN STARTEND; BEGINEND; ONCEEND; RESPEND END ;
ie FILL ; BDB(BREAKM ← 0 ; SPACEM ← SPACEM MIN 1) ;
ie FLUSH LEFT ; BDB(BREAKM←2) ;
ie FLUSH RIGHT ; BDB(BREAKM←3) ;
ie FONT ; DFONT(FALSE);
ie GROUP ; IF GROUPM THEN PASS ELSE BDB(GROUPM←1) ;
ie GROUP SKIP ; DSKIP(TRUE) ;
ie IF ; DCONDITIONAL ;
ie INDENT ; DINDENT ;
ie INSERT ; DINSERT ;
ie JUSTJUST ; BDB(BREAKM←1) ;
ie LET ; DLET ;
ie LOCK ; DLOCK ;
ie MACRO ; DMACRO(1) ;
ie NARROW ; DMARGINS(1) ; COMMENT SEMI-OBSOLETE ;
ie NEXT ; BEGIN PASS ; DNEXT END ;
ie NOFILL ; BDB(BREAKM←7) ;
ie NOJUST ; BDB(JUSTM←0) ;
ie ONCE ; BEGIN IF ON∧ENDCASE≠2 THEN BEGIN INTEGER S ; S ← STARTS ; STARTS ← 0 ;
BEGINBLOCK(FALSE,2,ALTMODE) ; STARTS ← S ; END ; PASS END ;
ie PACK ; DPACK ;
ie PAGE FRAME ; DFRAME(FALSE) ;
ie PICHAR ; DPICHAR ;
ie PLACE ; BEGIN IF ON THEN DBREAK ; PASS ; PLACE(IX) ; PASS END ;
ie PORTION ; DPORTION ;
ie PREFACE ; BEGIN DBREAK; PASS; K←CVD(E("0",NULL)); IF ON THEN IF FILL THEN LEADFM←K ELSE LEADNM←K END ;
ie RECEIVE ; DRECEIVE ;
ie RECURSIVE MACRO ; DMACRO(0) ;
ie REQUIRE ; DREQUIRE ;
ie RETAIN ; DB(SPACEM←0) ;
ie SELECT ; DFONT(TRUE) ;
ie SEND ; DSEND ;
ie SHOW ; DSHOW ;
ie SKIP ; DSKIP(FALSE) ;
ie START ; BEGIN BEGINBLOCK(FALSE,0,IF THATISCON THEN SPASS(THATWD[2 TO ∞]) ELSE NULL) ; PASS END;
ie SUPERIMPOSE ; DSUPERIMPOSE ;
ie TABS ; DTABS ;
ie TEXT AREA ; DAREA(FALSE) ;
ie TITLE AREA ; DAREA(TRUE) ;
ie TURN OFF ; DTURN(0) ;
ie TURN ON ; DTURN(-1) ;
ie USERERR ; DUSERERR ; RKJ: 1-9-74;
ie VARIABLE ; DLOCAL ;
ie VERBATIM ; BDB(BREAKM←6) ;
ie WIDEN ; DMARGINS(-1) ; COMMENT SEMI-OBSOLETE ;
END ; COMMENT COMMANDS ;
IF ITSCH(;) THEN PASS ;
RETURN(TRUE) ;
END ;
INTERNAL RECURSIVE BOOLEAN PROCEDURE CHUNK(BOOLEAN VALID) ;
BEGIN
IF PAGEMARKS > PAGEWAS THEN
BEGIN comment, might be AT PAGEMARK response ;
FOR PAGEWAS ← PAGEWAS + 1 THRU PAGEMARKS DO IF SIGNALD[FF] THEN RESPOND(SIGNALD[FF]) ;
PAGEWAS ← PAGEMARKS ;
END ;
RETURN(THISISID AND (ASSIGNMENT OR LABELDEF OR COMMAND) OR TEXTLINE OR EMPTYCHUNK OR NONSENSE(VALID)) ;
END "CHUNK" ;
INTERNAL SIMPLE PROCEDURE MANUSCRIPT ;
BEGIN
BOOLEAN VALID ;
VALID ← TRUE ;
DO VALID ← CHUNK(VALID) UNTIL LAST < 1 ;
IF ¬NEXTS(7!MANUSCRIPT) THEN WARN("=","BRACKETS DON'T PAIR UP!!!!!!!!!") ;
FINPORTION ; IF BLNMS=0 THEN BEGINEND ELSE IF BLNMS>0 THEN
WARN("=",CVS(BLNMS) & " EXTRA BEGIN'S AND STARTS") ;
END "MANUSCRIPT" ;
END "INNER BLOCK" ;
END "PARSER"